home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1996 #15 / Monster Media Number 15 (Monster Media)(July 1996).ISO / os2 / srefv112.zip / SREFILTR.A80 < prev    next >
Text File  |  1996-05-29  |  129KB  |  3,838 lines
  1. /* sre-filter ver 1.11
  2.  a HTTP  filter prgram, written in REXX,
  3.  for use with the GOSERVE internet server
  4.  
  5.   This program was written by Daniel Hellerstein, DANIELH@ECON.AG.GOV, 5/24/96
  6.   Feel free to use  and distribute this beta test software.
  7.  
  8.   Copyright is retained by the author, but no limits are placed on the
  9.   use of any portion of the code found herein.
  10.  
  11. Disclaimer:
  12.  This program, and associated files, is not in any way an official, 
  13.  semi-official, or unofficial product of my employers (USDA/ERS).
  14.  
  15.  At this writing (5/24/96), it is a beta-test program -- 
  16.  no liability can be assumed for errors in the program,
  17.  and NO warranty is hereby issued.  USE this at YOUR own risk.
  18.  
  19.         That said, our experience indicates that this is
  20.         a stable product.  However, should you discover
  21.         problems with this software, PLEASE contact
  22.         Daniel Hellerstein at the above E-mail address!
  23.  
  24.   (Plese see the READ.ME file for the full disclaimer)
  25. */
  26.  
  27. /*******************************************************************************/
  28. /*       ------------------------  Description ------------------------------- */
  29. /*
  30.  
  31. GoServe, an IBM EWS Internet server, requires "filter" programs to properly
  32. respond to HTTP requests.  GoServe itself handles the details of communications.
  33.  
  34. SRE-FILTER (until we come up with a better name) is designed for this role.
  35. SRE-FILTER is meant to provide an easy to configure and maintain Web Server
  36. for small to medium sites.  It lacks certain high-end features, but it
  37. provides a number of features designed to ease the creation of sets of web pages.
  38.  
  39. For a detailed description of how to use this filter, see the SREFILTER.HTM
  40. and SUMMARY.HTM files.  You may also want to look at INITFILT.DOC -- which
  41. describes in some detail the user-configurable parameters used by SRE-FILTER.
  42. Lastly, the FILTINST.HTM document provides a front-end to an on-line configuator.
  43.  
  44. ----------------
  45. The following summarizes the steps SRE-FILTER takes when considering a request:
  46.  
  47. 1) Set up default values for user-configurable parameters.  Most of these
  48.    are reset at step 2.
  49.  
  50. 1a) If necessary, read SREFLIB1.RXL procedure libarary into macrospace.
  51.  
  52. 1b) Parse the request, ip address, etc. (from GoServe)
  53.  
  54. 2) Read INITFILT.80, which contains a number of user-configurable parameters,
  55.    and the names of various files and directories needed by SRE-FILTER.
  56.  
  57.    The ambitous programmer could forgo the use of INITFILT.80 by hard coding
  58.    these values at step 1, and setting the INITFILT_FILE variable to " ".
  59.  
  60.    Note that INITFILT is "interpreted" by REXX -- if a syntax error occurs,
  61.    the remainder of INITFILT.80 is skipped.  You should probably use PMPRINTF
  62.    to check the status of SRE-FILTER anytime you change INITFILT.
  63.  
  64. 3)  Clean up results from steps 1 and 2.
  65.  
  66. 4) Check on, and create if necessary, a few "counter files"
  67.  
  68. 4a) Load "input files" into macrospace (if a change detected)
  69.  
  70. 5) If the requested action is one of the PUBLIC_ACTIONS, then skip all the
  71.    logon/access-control stuff.   Otherwise..
  72.  
  73. 6) DeterminE if logon is needed.
  74.     Check to see if this IP is an owner
  75.     Check to see if this is inhouse or in user_file
  76.  
  77. 6a) If ALLOW_ACCESS is binding, see if this request string is
  78.    "not accessible" to this client. Note that the original, non-modified,
  79.     request string is examined (as sent by the client, prior to
  80.     "alias replacement", etc. by this filter)
  81. 6b) see if ssi and ssp privs are granted (checking privilege list)
  82.  
  83. 6c)If access is allowed, and RECORD_OPTION=YES or YES_ALL), then
  84.    records reciept of this URL (if YES, then minus any stuff ?xxx).
  85.  
  86. 7) Process the request string:
  87.   a1) See if empty request.  If so, action=Default
  88.  
  89.    (NOTE: Jump here if a PUBLIC_FILES was requested)
  90.  
  91.   a2) If check_alias is on, then see if this action is an alias for some other action
  92.      If so, use this other action
  93.  
  94.        Skip to a5 if  VERB <> GET
  95.  
  96.        Skip to 10 if a PUBLIC_FILES was requested
  97.  
  98.  
  99.   a3) Syntax check: is this a "no extension request?" (no ?, and no . in the
  100.      final portion of the request string)
  101.      If so, append something to the end ?
  102.  
  103.   a4) See if this action is "directory" name (not the root directory though).,
  104.       i.e. xxx/yyy/. If so,
  105.      check autoname for candidate "directory's default document" names
  106.      (note: if ismap_url string, or CGI-BIN appear in the sel, skip
  107.      this step)
  108.   a5) Process the verb, using the SEL from steps a2-a5.
  109.      a5b) If the action is for a document which does not exist (and VERB=GET)
  110.          go back to autoname and try again
  111.  
  112. 8) Replace ~ with the HOME_DIR.
  113.  
  114. 9) Maybe ask for privilege info (if privs needed and logon was not required)
  115.  
  116. 10) Do "virtual drive" substitution on the sel.  
  117.     Among other uses, this allows non data-directory
  118.     files to be freely accessible.  It also is used to change the location
  119.     of server side routines, mappable images, and cgi-bin programs (when
  120.     used with an appropriate alias).  
  121.  
  122. 11) a) If "special request" (begins with !), do it now.
  123.  
  124.    b) If HEAD. Do a very simple HEAD request.  This should be fixed up in the future.
  125.  
  126.    c) If a GET request, determine 1 of 4 classes:
  127.       i)   1) Simple file name  eg;  /ZIPFIP/ZIPFIP.HTM
  128.            File is retrived, with possible ssi's
  129.          2) File name with OPTIONS, eg; /OVERVIEW.HTM?From+ZIPFIP+main+page
  130.             File is retrieved, with possible sss's (some of which may use these OPTIONS
  131.                 Note: server side includes (ssi's) are accomplished with:
  132.                         HEADERS and FOOTERS
  133.                         REPLACE INCLUDE OPTIONS and INTERPRET keyphrases
  134.                                 which are processed recursively
  135.  
  136.          3) Form name with parameters, eg; /CALC/DOCALC?12-34%2B51
  137.              sref_getpost is called with appropriate arguments
  138.          4) Mappable image (ISMAP) response.  URL must include the
  139.            ismap_url string (say, MAPIMAGE/).
  140.            Eg  ISMAPDIR/US/USMAP?41+239
  141.  
  142.           Note: ISINDEX type searchable-index requests are identical in
  143.              appearance to case 2.  To avoid this problem, use an ALIAS
  144.              to a class 3 (i.e.; that requests DOSEARCH)
  145.  
  146.        ii) If case 1 or 2; check for existence of file.
  147.            Do server side includes
  148.            Return the file (possibly modified)
  149.                 If accept_range is yes, then maybe only return a byte range.
  150.  
  151.        iii) If case 3 or 4
  152.            If case 4, call image map handler (which will do a redirect )
  153.            If SENDFILE or GETAFILE, prepare a few variables
  154.            Call sref_getpost "server side processing" handler external routine
  155.  
  156.      d) If POST request
  157.             Call sref_getpost "server side processing" handler external routine
  158.  
  159. 12) If POST_FILTER=YES, then before returning call the POSTFILT.80
  160.     routine.  POST_FILTER is ALWAYS called (regardless of whether
  161.     successful transaction occurred). Note that POST_FILTER
  162.     processing occurs AFTER a "completion code" (after the response
  163.     has been sent back to the client).  Thus, complicated Post_filter's
  164.     will not slow down response time (except to the extent that it
  165.     bogs down the computer for the NEXT client!)
  166.  
  167.  
  168. ------------------
  169. NOTES NOTES NOTES
  170.  
  171.  
  172. 1) Sre-filter uses a "macrospace library", loaded from SREFLIB1.RXL, to store a
  173.    number of useful routines.  Their names all begin with SREF_.
  174.    For information on these routines, see SREFLIB1.DOC.
  175.    Note that the REXXLIB utility library is used (see SREFLIB1.DOC for details
  176.    on this defunct shareware)
  177.  
  178. 2)   A note on caching:
  179.  
  180.   SRE-FILTER will allow caching when:
  181.         CHECKLOG=NO
  182.         ALLOW_ACCESS=YES
  183.         no server side includes were performed.
  184.   If any of these conditions are not meant, then NOCAHCE will be specified
  185.   on all file transfers.
  186.  
  187. 3) A note on ports:
  188.  
  189.   We assume here that GoServe is using port 80.  If it is not:
  190.   you will need to change the names of all SRE-FILTER files that end with
  191.    .80 to be the .nnn, where nnn is the port being used by GoServe (nnn
  192.    can be > 3 digits if HPFS is being used).
  193.         In particular, change the names of SREFILTR.nnn and initfilt.nnn.
  194.  
  195.   It is possible to run multiple instances of the
  196.   server, using different ports, different working directories (and
  197.   possibly different data directories), and different copies of the
  198.   various .IN, .CTL, .CNT, and (most importantly) the .80 (now .nnn) files.
  199.  
  200.   HOWEVER, only one of the "ports" will use the .IN files that are
  201.   stored in macro_space.  By default, this will be port 80.  To change
  202.   this, you'll have to "recompile" SREFLIB1.RXL (see SREF1LIB.DOC for
  203.   notes on this).
  204.  
  205.  
  206. 3a) To cause SRE-FILTER to "SEND" portions of files containing
  207.     server side includes (this can speed up early display on the
  208.     client end), set:
  209.      auto_header='HEAD'
  210.      delim_1.2=0                 
  211.      retain_bad_keyphrases='NO'
  212.      fix_expire=0
  213.  
  214. 4) To add mediatypes, you will have to modify the SREF_MEDIATYPE
  215.   routine that is stored in "macrospace" (see SREFLIB1.DOC for note on this)
  216.  
  217. 5) Structure of GOSERV call to this filter
  218.    Source request sel::   151.121.65.143 80 3 151.121.65.143 1026
  219.    request                GET /sampask2.htm HTTP/1.0  :
  220.    sel                    sampask2.htm
  221.  Example:
  222.    source :   151.121.65.143 80 4 151.121.65.143 1027
  223.    request: GET /CheckQ?searchText=very+silly+ind&andOr=and HTTP/1.0
  224.    sel:     CheckQ?searchText=very+silly+indeed!&andOr=and
  225.  
  226. */
  227.              /* ---------------- End of Description   ------------------ */
  228. /**************************************************************************************/
  229.  
  230.  
  231.  
  232. /*************************************************************************************/
  233. /*  -----------------           Initializations ----------------------------------*/
  234.  
  235. /*    ----------------- Default initialization ---------------------*/
  236. /* . Default values --   user can change
  237. .   (but it is recommended that INITFILT be changed instead) */
  238. /* --------------------------------------------------------------- */
  239.  
  240. checklog='NO'           /* Free entry */
  241. inhouse_name="OUR WEB SITE"           /* name we call "ourselves" */
  242.  
  243. home_name=" "              /* The colloquial (not necessrily ip
  244.                             name of this domain,) Note use in not_found_url */
  245.  
  246.  
  247. auto_header="NO"        /* no, always, head */
  248.  
  249. no_include="NO"
  250. no_processing="NO"              /* if yes, then no server side processing attempted */
  251.  
  252. delim_1.1='<!--'     /* the left and right side "keyphrase" delimeters */
  253. delim_2.1='-->'      /* can be any string combo */
  254.  
  255. retain_bad_keyphrases="YES"
  256.  
  257. upload_maxsize=50             /* max size that a uploaded file can be, in k */
  258. upload_minfree=20000        /* minimum free in K, in dowload_dir, AFTER file upload */
  259.  
  260. upload_maxsize0=upload_maxsize
  261. upload_Minfree0=upload_minfree    /*use these if error in specifying upload vars */
  262.  
  263. AUTO_NAME=0         /* YES=if request is of from /foobar/papers/
  264.                         then look for /foobar/papers/papers.htm.
  265.                         NO = don't check
  266.                         INDEX = look for /foobar/papers/index.htm */
  267.  
  268. CHECK_alias="YES"   /* check all "sels" in the alias file: YES=yes, NO=None,
  269.                       HTML=.HTM (or .HTML) files only */
  270.  
  271. not_found_url='<a href="/"> Visit the '||home_name||' home page? </a> '
  272.                                  /* Message that is sent
  273.                                       along with "no such url" response*/
  274.  
  275.  
  276. prefilter_result=" "     /* filled in only if prefiltr called */
  277. pre_filter="NO"         /* no  yes first */
  278.  
  279. post_filter="NO"
  280. post_filter_message=" "
  281.  
  282. postfilter_name="POSTFILT"              /* may be reset in initfilt */
  283. prefilter_name="PREFILTR"
  284.  
  285.  
  286. noext_type="HTM"  /* NONE DIR HTM or HTML */
  287.  
  288. record_option="NO"   /* YES, YES_ALL */
  289.  
  290. no_getafile_control="YES"   /* who can use getafile (YES=everyone*/
  291. allow_access="YES"  /* access control on file transfers (YES=none) */
  292.  
  293. default='index.htm'     /* use if default home page selected */
  294.  
  295. inhouseips.1=0  /* valid example: inhouseips.1="151.121.65" */
  296. privset1= " "
  297.  
  298. inhouse_privs=" INHOUSE "    /* additional privs for inhouseips and owners */
  299. public_privs=" PUBLIC "    /* additional privs for veryone */
  300.  
  301. max_pointdist=50     /* max distance acceptable for a "assign to point" in ncsa map */
  302.  
  303. /* Used with REPLACE:INHOUSE1, etc. */
  304. inhouse.1=" (INHOUSE User) "
  305. inhouse.2=' .. return to <a href="/"> home page </a>?'
  306. superuser.1="(Super User)"
  307.  
  308. headers.1=0  /* stuff to put at beginning / end of */
  309. footers.1=0  /* all htm documents. 0= nothing */
  310.  
  311. public_files.1=0    /* list of public_files (no logon needed to access them
  312.                         actually, public_files can be an aliase
  313.                         HITHERE   WELCOME/INTRO.HTM
  314.                        would take all requests for HITHERE and return the contents (with
  315.                        ssi's) of datadir/WELCOME/INTRO.HTM
  316.                         ALso, abbreviation matchine is supported
  317.                         If public_files.1=0, there are none */
  318.  
  319.  
  320. OPTION_hit_line=":: still access # "
  321.  
  322. /* used  for error message  et al */
  323. webmaster=' (no contact available) '
  324. /* note: you might also want to put a CONTACT line in the repstrgs_file file. */
  325.  
  326. /* Owners are automatically superusers (seperate with spaces) */
  327. owners   = 'none'
  328.  
  329. /* smtp_gateway, used by post-filter "e-mail alert" facility */
  330. smtp_gateway=" "   
  331.  
  332. ismap_url="mapimage/"   /* urls that begin with this are assumed to
  333.                            be responses from mappable images */
  334.  
  335.  
  336. macrospace_input="YES"  /* YES or NO (if NO, don't use macrospace for .IN files */
  337.  
  338.  
  339. cgi_bin_dir=0                   /* if 0, do not emulate cgi-bin */
  340.  
  341. messbox_dir="\GOSERV\DATA"                        /* SRE-FILTER data */
  342. upload_dir=messbox_dir
  343.  
  344. /* work directory(for storage of temporary files)
  345.    should be in the data directory */
  346. tempfile_dir="E:\gohttp\temp"
  347.  
  348. counter_file="\GOSERV\data\COUNTER.CNT"
  349. record_all_file="\GOSERV\DATA\RECRDALL.CNT"
  350. sendfile_file="\GOSERV\DATA\SENDFILE.CTL"
  351. access_file="\GOSERV\DATA\ALL_FILE.CTL"
  352.  
  353. accept_range="NO"
  354.  
  355. virtual_file="\GOSERV\VIRTUAL.IN"
  356.  
  357. user_file="\GOSERV\USERS.IN"
  358.  
  359. interpret_file="\GOSERV\INTERPET.IN"
  360. repstrgs_file="\GOSERV\REPSTRGS.IN"
  361. alias_file="\GOSERV\ALIASES.IN"
  362. upload_log="\GOSERV\DATA\UPLOAD.LOG"
  363.  
  364. SSI_ALLOW="YES"
  365. SSP_ALLOW="YES"
  366.  
  367. fix_expire=0    /* set to non zero to redo response headers */
  368.  
  369.  
  370. /* Change this if you install goserve in a non-standard directory */
  371.  
  372.  servdir='workingdirectory'
  373.  
  374. /* servdir='drive:\working directory'  */
  375.  
  376. /* This is where various "users" home directories are ( as
  377. signified by the ~ character in a SEL). Note that the contents of
  378. Home_dir substitue for the ~, with no syntax checking.  Thus,
  379. if Home_dir = "/USERDIR/", and the sel is /~JOES/PAGE.HTM,
  380. the result will be //USERDIR/JOES/PAGE.HTM -- which is INCORRECT
  381. (a correct entry would be HOME_DIR = "USER_DIR/") 
  382. Note that virtual drive replacement occurs After HOMEDIR replacement
  383. */
  384.  
  385. home_dir="HOMEDIR"
  386.  
  387. /* this is needed to determine default names ... */
  388. serverport=extract(serverport)
  389.  
  390.  
  391. /* the initfilt file (can be set to "" if above defaults are appropriately set) */
  392. initfilt_file=servdir||"\INITFILT."||serverport
  393.  
  394.  
  395. /* -------End of  Default initialization section. -------------------- */
  396.  
  397.  
  398. /*--------------   Load REXX libraries ----- */
  399. /* Load up advanced REXX functions */
  400.  
  401. foo=rxfuncquery('sysloadfuncs')
  402. if foo=1 then do
  403.   say 'Loading REXXUtil library '
  404.   call RxFuncAdd 'SysLoadFuncs', 'RexxUtil', 'SysLoadFuncs'
  405.   call SysLoadFuncs
  406. end
  407.  
  408.  
  409.  
  410. foo=rxfuncquery('rexxlibregister')
  411. if foo=1 then do
  412.  say ' loading REXXLIB '
  413.  call rxfuncadd 'rexxlibregister','rexxlib', 'rexxlibregister'
  414.  call rexxlibregister
  415. end
  416.  
  417.  
  418.  
  419.  /* load sre-filter procs into macrospace */
  420. first_load=0                    /* signal if this is first load */
  421.  
  422.  
  423. foo=directory(servdir)   /* reset to working directory */
  424.  
  425.  
  426. /* ---------Get stuff sent from GOSERVE program -----------------*/
  427. parse arg source, request , selx                         
  428. source0=source ; request0=request ; seloriginal=selx
  429. parse var request foo sel .
  430. sel=strip(sel,'l','/')              /* get rid of leading / */
  431. parse var source myaddr port transaction who whoport . /* Often useful */
  432.  
  433.  
  434. /* -- get macrospace libraries, or load if not there */
  435. nosref0=1
  436. signal on syntax name nosref
  437. filter_name=sref_version()   /* if not here, then skip to nosref */
  438.  
  439. nosref0=0
  440. nosref:         /* if skipped here, then load .rxl */
  441. signal off syntax
  442. if nosref0=1  then do
  443.    say " Loading SREFPRC1.RXL into macrospace "
  444.    first_load=1
  445.    tt=servdir||'\SREFPRC1.RXL'
  446.    aa=macroload(tt)
  447.    if aa=0 then do
  448.          say " ERROR: " tt " not available! " aa
  449.          audit " ERROR: " tt " not available! " aa
  450.          return "NODATA"
  451.    end 
  452.    filter_name=sref_version()   
  453.    say " Starting on port " serverport  ": "  filter_name
  454. end
  455.  
  456.  
  457. /* ------ Initialize parameters using external 'user-set' initialization file----*/
  458. /*. Now, call the initialzation parameters external routine (INITFILT.80).
  459. .   Users are encouraged to set up initialization parameters by changing
  460. .   INITFILT, and not by changing this "main" program.
  461. */
  462. if initfilt_file<>"" then 
  463.     call get_initfilt 1
  464.  
  465. if default="" then do
  466.    default="INDEX.HTM"  /* the traditional case */
  467.    audit " Missing DEFAULT -- check INITFILT! "
  468.    say " Missing DEFAULT -- check INITFILT! "
  469. end
  470.  
  471.  
  472. initdone:   /* note: jump here if no_initfile="YES" */
  473.  
  474.  
  475.  
  476. /*  -----------------Tidy up some initialization parameters ------------ */
  477.  
  478. current_hit.num=0      /* 0 means not counted yet */
  479. current_hit.item=""
  480. current_hit.mess1=""
  481. current_hit.mess2=""
  482. outbig=''
  483.  
  484. /* Clean up parameters that may have been set in initfilt */
  485. inhouse=translate(inhouse_Name)  /* we changed the name of INHOUSE to INHOUSE_NAME */
  486. inhouse_name=inhouse      /* to ease customization.  BUt it's a pain to change in the code!*/
  487.                           /* so we'll still use INHOUSE in the code */
  488.  
  489. checklog=STRIP(translate(checklog))   /* NO YES ALWAYS INHOUSE */
  490. if auto_Name=0 then auto_name=" "
  491.  
  492.    auto_name=translate(auto_name)
  493. selautoname=""          /* avoid problems with public_Files */
  494.  
  495. check_alias=STRIP(translate(check_alias)) /*NO YES HTM*/
  496.  
  497.  
  498. accept_range=is_true(accept_range,'Y YES')
  499. no_include=is_true(no_include,'Y YES')
  500. no_processing=is_true(no_processing,'Y YES')
  501.  
  502. DEFAULT=STRIP(DEFAULT)
  503. ismap_url=strip(translate(ismap_url)) ;
  504.    ismap_url=translate(ismap_url,'/','\')
  505.    ismap_url=strip(ismap_url,'L','/')
  506. messbox_dir=translate(messbox_dir,'\','/')
  507.    messbox_dir=strip(messbox_dir,'t','\')  /* d:\foo\bar format needed  */
  508. cgi_bin_dir=translate(cgi_bin_dir,'\','/')
  509.    cgi_bin_dir=strip(cgi_bin_dir,'t','\')
  510.    if cbi_bin_dir="" then cgi_bin_dir=0
  511. inhouse_privs=translate(inhouse_privs)
  512.    if inhouse_privs=0 then inhouse_privs=" "
  513. public_privs=translate(public_privs)
  514.    if public_privs=0 then public_privs=" "
  515.  
  516. replines.0=-1           /* signal that is hasn't been read in */
  517. interp_data=0
  518.  
  519. HOME_DIR=STRIP(HOME_DIR)
  520. virtual_file=strip(virtual_file)
  521. virtual_dir.0=0
  522.  
  523. macrospace_input=is_true(macrospace_input,'Y YES ')
  524.  
  525. ALLOW_ACCESS=TRANSLATE(STRIP(ALLOW_ACCESS))
  526. if abbrev(allow_access,"Y")=1 then 
  527.    allow_access="YES"
  528.  
  529. ssi_allow=is_true(SSI_ALLOW,'Y YES ')
  530. ssp_allow=is_true(ssp_allow,'Y YES ')
  531.  
  532. retain_bad_keyphrases=is_true(retain_bad_keyphrases,'YES Y ')
  533.  
  534.  
  535. RECORD_OPTION=TRANSLATE(STRIP(RECORD_option))
  536. NO_GETAFILE_CONTROL=TRANSLATE(STRIP(NO_GETAFILE_CONTROL))
  537.  
  538. DNS_CHECK=translate(dns_check)
  539.  
  540. if upload_log="" then upload_log=0
  541.  
  542. if datatype(upload_maxsize)<>'NUM' then
  543.     upload_maxsize=upload_maxsize0
  544. if datatype(upload_minfree)<>'NUM' then
  545.     upload_minfree=upload_minfree0
  546.  
  547. pre_filter=translate(pre_filter)
  548.  
  549. post_filter=is_true(post_filter,'Y YES ')
  550.  
  551. if smtp_gateway=" " then smtp_gateway=0
  552.  
  553. cache_status="NOCACHE"
  554. is_public=0
  555. is_alias=0
  556.  
  557.  
  558. post_message=" "
  559.  
  560. RECORD_OPTION=TRANSLATE(RECORD_OPTION)
  561. if wordpos(record_option,'YES YES_ALL ')=0 then
  562.      record_option="NO"              /* recording option on?*/
  563.  
  564. privset=public_privs                /* generic privilege set */
  565.  
  566.  
  567. /* check/initialize counter files, and load up input files into macrospace */
  568. if first_load=1 then do
  569.   res1=sref_init_counter(counter_file, upload_log , record_all_file , record_option)
  570.   parse var res1 counter_file  upload_log  record_all_file  record_option
  571.   if macrospace_input=1 then
  572.       okay=sref_load_mac(servdir,user_File,initfilt_file,repstrgs_File, ,
  573.               alias_file,interpret_file,virtual_file,access_file)
  574. end
  575.  
  576. /* check if initfilt has been updated, if so, update macrospace */
  577. if (first_load=0 & macrospace_input=1) | (transaction=1)then do
  578.     eek=sysfiletree(translate(initfilt_file,'\','/'),'gosh','FT')
  579.     if gosh.0>0 then do  /* no file */
  580.          parse var gosh.1  atime .
  581.          filedate=sref_juldate('F',atime)
  582.          signal on error name not_load_mspace
  583.          signal on syntax name not_load_mspace
  584.          somestuff=sref_macro_initfilt()
  585.          parse var somestuff mdate .
  586.          if mdate<filedate | transaction=1 then do
  587.             say " Updating INITFILT file ... "
  588.             okay=sref_load_mac(servdir,user_File,initfilt_file,repstrgs_File, ,
  589.                 alias_file,interpret_file,virtual_file,access_file)
  590.           end
  591.      end
  592. end
  593. not_load_mspace:
  594. signal off syntax 
  595. signal off error
  596.  
  597. /*  More global variables ............. */
  598. tmp.0=0                 /* for use by INTERPRET blocks */
  599. crlf='0d0a'x            /* might need this */
  600.  
  601. dir = datadir()          /* Data directory (root of all data directories) */
  602.                          /* [must include drive and end in '/'] */
  603.  
  604. wd40=translate(tempfile_dir,'/','\')
  605. parse var wd40 (dir) data_temp_dir
  606. data_temp_dir=translate(data_temp_dir||'/')    /* don't record transfers from temp
  607.                                               directory of data directory */
  608. /* other possibly useful stuff */
  609. servername=servername()
  610.  
  611. cgi_inc_errmsg="Error in CGI Include "
  612. cgi_inc_sizefmt="ABBREV"
  613. cgi_inc_timefmt="ALL"
  614.  
  615.  
  616. /* ---------------------- End of initialization section   ------------*/
  617. /***********************************************************************/
  618.  
  619. /***********************************************************************/
  620. /* ---------------------- Start of active code for main filter   ------*/
  621.  
  622.  
  623. tempfile=dir'$'transaction'.'port                      /* Often used */
  624. clientname0=who
  625.  
  626.  
  627. /* Note: to view results of SAY commands, START PMPRINTF from an OS/2 window */
  628. say 'SRE-FILTER on port ' serverport ' # '  transaction " from " who " , "  whoport " : " request
  629.  
  630. /* call a pre-filter (it might EXIT back to GoServe)
  631. The pre-filter should check for completion! */
  632. if pre_filter="FIRST" then do
  633.     prefilter_result=do_prefiltr(' ')
  634.     parse var prefilter_result status ',' prefilter_result
  635.     a=done_it(status,"Pre-filter processed: "||prefilter_result)
  636.     if a=1 then
  637.       if post_filter=0 then
  638.          return ' '
  639.       else do
  640.           post_filter_message="Pre-filter used"
  641.           signal do_post_filter
  642.       end
  643.  
  644. end
  645. parse var request verb uri protocol .        /* split up the request line */
  646.  
  647.  
  648. /* BEFORE ANYTHING ELSE, MAKE SURE THE REQUEST IS STILL ACTIVE!!
  649. (IF CACHING OCCURED, IT MIGHT NOT BE !! */
  650. aa=done_it(0,'From cache: '||seloriginal)   /* done_it will EXIT */
  651. if aa=1 then DO
  652.     If record_option<>"NO" then do
  653.             if record_option="YES" then
  654.                 parse var seloriginal doit '?' .
  655.             else
  656.                 doit=seloriginal
  657.             foo=sref_lookup_count(record_all_file,doit,'ADD','OK',2)
  658.     end
  659.     if post_filter=0 then
  660.          return ' '
  661.       else do
  662.           post_filter_message="Cached file sent:"||seloriginal
  663.           signal do_post_filter
  664.       end
  665. END
  666.  
  667. /* Check request for basic grooviness*/
  668. if left(protocol,4)\='HTTP' & protocol\='' then do
  669.        if post_filter=0 then
  670.           return response('badreq', 'specified a protocol that was not HTTP')
  671.        else do
  672.           dog=response('badreq', 'specified a protocol that was not HTTP')
  673.           dog
  674.           post_filter_message='Bad HTTP Protocol '
  675.           signal do_post_filter
  676.       end
  677. end
  678.  
  679. /* Is it one of the PUBLIC_FILES ??. IF so, skip logons, requests
  680. string modifications, and  send it  (but DO ssi's) */
  681. tsel=translate(sel)
  682. gotit=0 ; doexact=0
  683. do m=1 to 100000                        /* look in public_files list */
  684.     if  symbol('public_files.m')<>"VAR"  then leave
  685.     ares=sref_wildcard(tsel,public_files.m,doexact)
  686.     parse var ares astat "," aurl ;  astat=strip(astat)
  687.     if astat=0 then iterate   /* no match */
  688.     usesel=sel
  689.     gotit=m
  690.     usesel=sel
  691.     if ares=1 then
  692.        leave           /*first exact match rules */
  693.     else
  694.        doexact=1
  695. end
  696.  
  697. if gotit>0 then do        /* if gotit, then reset the sel */
  698.     sel=usesel
  699.     say " PUBLIC_FILE. " gotit " being used: " sel 
  700.     is_public=1 ;
  701.     home_dir="" ; auto_name=" "       /* just to be safe */
  702.     privset=" PUBLICFILE PUBLIC "   /*getafile uses this to suspend no_getafile_control*/
  703.     cache_status=' '     /* it's public, so you might as well allow caching */
  704.  
  705. /* Do we record all "not unallowed" requests  */
  706.     if record_option<>"NO" then do
  707.             if record_option="YES" then
  708.                 parse var seloriginal doit '?' .
  709.             else
  710.                 doit=seloriginal
  711.             foo=sref_lookup_count(record_all_file,doit,'ADD','OK',2)
  712.     end
  713.     signal  do_alias      /*  do the verb (skip logons, request mods, etc */
  714. end
  715.  
  716. /* if here, not a public_file ... */
  717. /* ---------------- Check for logon rights and privileges --------- */
  718.  
  719.  
  720. afoo:
  721. /* check to see if requester is an unallowed ips */
  722.  
  723. call badips(who)
  724.  
  725. if result=1 then do  /* he is a bad ips, but we let owner and inhouse override it */
  726.   if wordpos(who,owners)=0 then do    /* no an owner */
  727.     call goodips(who)
  728.     if result=0 then do
  729.       if post_filter=0 then
  730.           return response('unauth', 'You are not permitted access to this server ')
  731.       else do
  732.           dog=response('unauth', 'You are not permitted access to this server ')
  733.           dog
  734.           post_filter_message="Unauthorized access "
  735.           signal do_post_filter
  736.       end
  737.     end
  738.   end
  739. end
  740.  
  741.  
  742. /* Do an DNS check? */
  743. if dns_check="YES" then do
  744.    clientname0=clientname()
  745.    if clientname0=who then do
  746.         audit ' Denied access to ' who
  747.         if post_filter=0 then
  748.            return response('unauth', 'No client name found, access to this server is denied. ')
  749.         else do
  750.            dog=response('unauth', 'No client name found, access to this server is denied. ')
  751.            dog
  752.            post_filter_message="No client name found, access denied "
  753.            signal do_post_filter
  754.         end
  755.     end
  756.     say " DNS check ok: " clientname0
  757.  
  758. end
  759.  
  760.  
  761. /* should we check for logon rights */
  762.   select
  763.      when checklog="YES" & (sel=" " | left(strip(sel),1)="/") then do
  764.         dologon=1
  765.         cache_status=' NOCACHE '
  766.  
  767.      end
  768.      when checklog="INHOUSE" then do
  769.          dologon=1
  770.          cache_status=' NOCACHE '   /* do NOT let goserve cache */
  771.      end
  772.      when checklog="ALWAYS" then do
  773.          dologon=1
  774.          cache_status=' NOCACHE '
  775.      end
  776.      otherwise do
  777.          dologon=0
  778.          if allow_access="YES" then  cache_status=' '
  779.      end
  780.   end
  781.  
  782.  
  783.  
  784. /* do logons, etc ... */
  785.   if  wordpos(who,owners)>0 then do   /* owners are treated with kid gloves */
  786.             privset="SUPERUSER INHOUSE "||inhouse_privs
  787.             username="OWNER" ;
  788.   end
  789.   else do                       /* non owners get the third degree? */
  790.      if  dologon=1 then do       /* yup, book 'em */
  791.          userinfo=do_logon(who,checklog)        /* if no match, exits (for new pwd or say sorry)  */
  792.          parse var Userinfo username privset
  793.  /*very tough--only inhouse allowed (explicit or as a privilege)?*/
  794.         if checklog="INHOUSE" & wordpos('INHOUSE',privset)=0 then  do
  795.           call lineout tempfile, '<!doctype html public "-//IETF//DTD HTML 2.0//EN">'
  796.           call lineout tempfile, "<html><head><title>Site Restricted to " inhouse " Staff</title>"
  797.           call lineout tempfile, "</head>"
  798.           call lineout tempfile, "<body><h2>Currently Restricted to " inhouse " Staff!</h2>"
  799.           call lineout tempfile, " Sorry, but until clearance details are worked out, this site "
  800.           call lineout tempfile, " is restricted to ' inhouse ' staff only. <b> "
  801.           call lineout tempfile, " If you have questions, please contact: "
  802.           call lineout tempfile, ' <address> ' webmaster  ' </address>'
  803.           call lineout tempfile, " </body> </html> "
  804.           call lineout tempfile
  805.           if post_filter=0 then
  806.                return 'FILE  ERASE TYPE text/html NAME ' tempfile
  807.           else do
  808.                 dog='FILE  ERASE TYPE text/html NAME ' ||tempfile
  809.                 dog
  810.                 post_filter_message="Logon denied to non-inhouse user "
  811.                 signal do_post_filter
  812.           end
  813.         end
  814.  
  815.  
  816. /* If here, welcome ! */
  817.         say '  Access by : ' username '(privs: ' privset
  818.  
  819.      end                /* dologon =1 */
  820.  
  821. /* If here, then no logons required, */
  822.      else do
  823.          call goodips(who)  /* is this an inhouse connect - get some privs! */
  824.  
  825.          isinhouse=result
  826.          if isinhouse=0 then
  827.             privset=" "
  828.          else
  829.             privset="INHOUSE "||inhouse_privs||privset1
  830.  
  831.  
  832.     end                 /* check if logon rwquired */
  833.  end                    /* not superuser */
  834.  
  835. /* add public_privs to everyone */
  836.  privset=privset||' '||public_privs
  837.  
  838.  
  839. /* now check on allow_access conditions, for this request string.
  840.  Note this will also check stuff after the ?
  841.  (use of * can circumvent this)  */
  842.  
  843.  okay1=sref_allow_access(seloriginal,allow_access,access_file,privset)
  844. /* if  not permiited, return appropriate message */
  845.  if okay1=0 then do
  846.       got1=not_allowed_message(clientname0,1)
  847.       got1='FILE ERASE TYPE text/html NAME '||tempfile
  848.       if post_filter=0 then
  849.               return got1
  850.       else do
  851.          got1
  852.          post_filter_message="No privileges for this request: "||sel
  853.         signal do_post_filter
  854.       end
  855.   end
  856.  
  857. /* Now check for ssi and ssp privs */
  858. if ssi_allow<>1 then do
  859.      aok=wordpos('NO_SSI',translate(okay1))
  860.      if aok<>0 then
  861.           no_include=1
  862. end
  863. if ssp_allow<>1 then do
  864.      aok=wordpos('NO_SSP',translate(okay1))
  865.      if aok<>0 then
  866.           no_processing=1
  867. end
  868.  
  869.  
  870.  
  871. /* otherwise, proceed as normal */
  872.  
  873. /* Do we record all "not unallowed" requests (portion ? */
  874. if record_option<>"NO" then do
  875.             if record_option="YES" then
  876.                 parse var seloriginal doit '?' .
  877.             else
  878.                 doit=seloriginal
  879.  
  880.             foo=sref_lookup_count(record_all_file,doit,'ADD','OK',2)
  881. end
  882.  
  883.  
  884. /* ----------------------------------------------------------------*/
  885. /* ----------- If here, logon okay and we have privileges  ---------------- */
  886.  
  887. /* Steps:
  888.   0) Call prefilter ?
  889.   1) See if empty request.  If so, SEL=Default
  890.   2) If check_alias is on, then see if this sel is an alias for some other sel.
  891.      If so, use this other sel
  892.  
  893. If VERB <> GET, jump to step 5
  894.   3) Syntax check: is this a "directory request?" (no ?, and no . in the
  895.      final portion of the request string)
  896.      If so, append a / to the end
  897.   4) See if this SEL is an "extension free" name
  898.        (but not the root directory though).,
  899.      If a at end (i.e. xxx/yyy/.
  900.         check autoname for candidate "directory's default document" names
  901.      If not, check NOEXT_TYPE; if DIR do above, otherwise, add appropriate
  902.      extension.
  903.  
  904.   5) Process the verb, using the SEL from steps 2-5.
  905.      5a) If the SEL is for a document which does not exist (and VERB=GET)
  906.          go back to autotname and try again
  907. */
  908.  
  909.  
  910. /* call a pre-filter (it might EXIT back to GoServe) */
  911.  
  912. if pre_filter="YES" then do
  913.    prefilter_result=do_prefiltr(privset)
  914.    parse var prefilter_result status "," prefilter_result
  915.    a=done_it(status,"Pre-filter processed:"||prefilter_result)  /* has the request been processed*/
  916.    if a=1 then
  917.       if post_filter=0 then
  918.          return ' '
  919.       else do
  920.           post_filter_message="Pre-filter used"
  921.           signal do_post_filter
  922.       end
  923.  
  924. end
  925.  
  926.  
  927. /* Check 'sel', see if it means "home page time" (root directory's default document). */
  928.  
  929.  if sel=' '  then
  930.        sel=default
  931.  else
  932.    if substr(sel,1,1)='?' then   /* simple, or with options */
  933.        sel=default||sel   /* default MUST be an HTML document  */
  934.  
  935.  
  936. /* Now see if the ACTION is really an alias for some other
  937.  action.  This is especially useful if an <ISINDEX> type of
  938.  searchable index has been responded to, which will have SEL
  939.  that typically looks like "COOLJUNK.HTM?A+B+C --
  940.  .. by default (with no alias checking),
  941.   this filter will assume that this is a request for the
  942.   HTML document COOLJUNK.HTM, with "options" A B C.
  943. (in a sense, the blank and / request strings are aliases for DEFAULT).
  944. */
  945.  
  946.  
  947. do_alias: nop                           /* jump here if is_public */
  948. if check_alias<>"NO" then do      /*see if 'action' is an alias for something else*/
  949.       if check_alias="YES"  then
  950.           doit=1
  951.       else do
  952.           amtype=sref_mediatype(action)
  953.           if left(check_alias,3)="HTM" & amtype="text/html" then
  954.                doit=1
  955.       end
  956.       if doit=1 then do         /* yes, check for an alias */
  957.           what1=alias_action(sel)
  958.           parse  var what1 gotit sel
  959.           sel=strip(sel)
  960.           if gotit > 0 then do          /* got a match */
  961.  
  962.                say " Alias # " gotit " resolves to: " sel
  963.                is_alias=1
  964.  
  965.  
  966. /* is this a "redirect" action?   */
  967.               if abbrev(translate(sel),'HTTP://')=1 then do
  968.                    if post_Filter=0 then
  969.                        return moved(sel,302)
  970.                    else do
  971.                         dog=moved(sel,302)
  972.                         dog
  973.                         post_filter_message="Alias invoked temporary redirect "
  974.                         signal do_post_filter
  975.                    end
  976.               end
  977. /* permanent move  */
  978.               if abbrev(translate(sel),"!MOVED")=1 then do
  979.                  taction=translate(sel)
  980.                  if abbrev(taction,'!MOVED=')=1 then
  981.                          action=delstr(sel,1,7)
  982.                  else
  983.                        if abbrev(taction,'!MOVED')=1 then
  984.                              action=delstr(sel,1,6)
  985.                   sel=sref_fix_url(action,servername,serverport)
  986.                   if post_filter=0 then
  987.                       return moved(sel,301)
  988.                   else do
  989.                       dog=moved(sel,301)
  990.                       dog
  991.                       post_filter_message="Alias invoked permanent redirect "
  992.                       signal do_post_filter
  993.                   end
  994.               end
  995.  
  996. /* temporary move  */
  997.               if abbrev(translate(sel),"!TEMP")=1 then do
  998.                  taction=translate(sel)
  999.                  if abbrev(taction,'!TEMP=')=1 then
  1000.                          action=delstr(sel,1,6)
  1001.                  else
  1002.                        if abbrev(taction,'!TEMP')=1 then
  1003.                              action=delstr(sel,1,5)
  1004.                  sel=sref_fix_url(action,servername,serverport)
  1005.                  if then
  1006.                        return moved(sel,302)
  1007.                   else do
  1008.                         dog=moved(sel,302)
  1009.                         dog
  1010.                         post_filter_message="Alias invoked temporary redirect "
  1011.                         signal do_post_filter
  1012.                   end
  1013.               end
  1014.  
  1015. /* is this a "send non-data directory file" action (OBSOLETE, but ...)*/
  1016.               if abbrev(translate(sel),"!TRANSFER")=1 then do
  1017.                  parse var sel action '?' awords
  1018.                  if post_filter=0 then
  1019.                     return send_non_datadir(action,awords)
  1020.                  else do
  1021.                      dog=send_non_datadir(action,awords)
  1022.                      dog
  1023.                      post_filter_message="Transfered non-data directory file"
  1024.                      signal do_post_filter
  1025.                  end
  1026.               end
  1027. /* Note: these obsolete functions are now supported, by directory, by
  1028. sref_dovirtual.  However, for single urls, it can be useful to use them
  1029. (rather then specifying a "directory" in the virtual_file */
  1030.  
  1031. /* else, just fix up \'s */
  1032.               parse var sel action '?' awords
  1033.               action=strip(translate(action,'/','\'))
  1034.               if pos('?',sel)<>0 then
  1035.                   sel=action||'?'||awords
  1036.               else
  1037.                  sel=action
  1038.  
  1039.           end           /* gotit > 0 */
  1040.  
  1041.      end                             /* doit=1 */
  1042. end                             /* alias checking */
  1043.  
  1044.  
  1045. if is_public=1 then signal do_verb      /* public_files are not autonamed */
  1046.  
  1047.  
  1048. /* The next stuff is for GET requests only, so skip otherwise */
  1049. if verb<>"GET" | left(sel,1)="!" then signal do_verb
  1050.  
  1051. /* Check sel to see if it's a "no extension" variant. If so, NOEXT_TYPE dictates
  1052.   what to do.
  1053.           Note that if ?xx appears after a extension-free action (say,
  1054.           yyy/xxx?abc), then we assume that this is an action request.
  1055. Otherwise...
  1056.   DIR: treat it as a "non-root directory's default document, but they forgot
  1057.       the final /".
  1058.  HTM or HTML : Add .HTM or .HTML respectively
  1059.   NONE : leave it be
  1060. */
  1061.  
  1062. /* if ? appears, leave it be:
  1063.      ether its an action name,
  1064.      or it's a xx/?yyy  (which is seen as xx/)
  1065. */
  1066. if pos('?',sel)=0 then do
  1067.    if right(sel,1)<>'/' then  do                /* it doesn't end with a */
  1068.        foo2=translate(sel,' ','/')
  1069.        lastword=word(foo2,words(foo2))  /* extract the last piece */
  1070.        foo2=pos('.',lastword)
  1071.        noexttype=translate(noext_type)
  1072.        if foo2=0 then                    /*  is no period in the last piece */
  1073.          select
  1074.           when noexttype="DIR" then do
  1075.              sel=sel||'/'                /* tIt's a directory*/
  1076.              say " Using re-named Sel: " sel
  1077.            end
  1078.            when noexttype="HTM" then do
  1079.               sel=sel||".HTM"           /* fat style html file */
  1080.               say " Using re-named Sel: " sel
  1081.            end
  1082.            when noexttype="HTML" then do
  1083.               sel=sel||".HTML"          /* html file */
  1084.               say " Using re-named Sel: " sel
  1085.            end
  1086.            when noexttype="NONE" then do
  1087.                nop                      /* leave it be */
  1088.            end
  1089.            otherwise do
  1090.                sel=sel||noext_type    /* user specified (experimental!) */
  1091.                say " Using re-named Sel: " sel
  1092.            end
  1093.         end             /* if select (sel does not end with name.ext) */
  1094.    end                  /* does not end in / */
  1095. end                     /* no ? in sel */
  1096.  
  1097. /*  See if we should look for sels of the type /xxx/yyy/, (no html file,
  1098.    just a directory, and what file to use if we find such a beast */
  1099.  
  1100. selautoname=sel   /* may need to reset sel (see GET verb processing below) */
  1101. if abbrev(translate(sel),"CGI-BIN")=1 | pos(translate(ismap_url),translate(sel))>0 then
  1102.      auto_name=""               /* never check if a mapimage or cgi-bin call */
  1103.  
  1104. goautoname:             /* hop here if no match, auto_name <> "" */
  1105. if auto_name<>" " then do     /* some candidate defaults? */
  1106.      parse var sel sel1 '?' stuff   /* get out name portion */
  1107.      sel1=strip(sel1)           /*be neurotic, strip out spaces */
  1108.      lensel1=length(sel1)
  1109.      foo1=substr(sel1,lensel1)  /*is last character a /, then maybe do autoname */
  1110.  
  1111.      if foo1='/'  then do        /* a request for default document */
  1112.         tryme=strip(word(auto_name,1))
  1113.         auto_name=delword(auto_name,1,1)  /* remove it from list */
  1114.         select
  1115.           when translate(tryme)="!CREATE" then do   /* create a list of links to files*/
  1116.                 no_getafile_control="YES"
  1117.                 sel1='getafile?dir=/'||sel1||'&gifs=YES&showdate=YES&showsize=YES&rootdir=!&iscreate='||sel
  1118.           end
  1119.          when translate(tryme)="!CREATE*" then do
  1120.                 no_getafile_control="YES"
  1121.                 sel1='getafile?dir=/'||sel1||'&gifs=YES&showdate=YES&showdir=YES&rootdir=!&showsize=YES&iscreate='||sel
  1122.           end
  1123.  
  1124.           when abbrev(tryme,'*')=0 then do
  1125.             if pos('/',tryme)=1 | pos(':',tryme)>0 then
  1126.                 sel1=tryme
  1127.             else
  1128.                 sel1=sel1||tryme
  1129.           end
  1130.           otherwise  do         /* *, *.htm, *.html, etc. */
  1131.             foo2=lastpos('/',sel1,lensel1-1)
  1132.             parse var tryme ast "." ext
  1133.             if ext="" then ext=".htm"
  1134.             sel1=sel1||substr(sel1,foo2+1,lensel1-(1+foo2))||'.'||ext
  1135.           end
  1136.         end             /* select */
  1137.         say "Trying auto-named sel = " sel1
  1138.         sel=sel1
  1139.      end
  1140.      else                      /* not a "request for directory */
  1141.         auto_name=' '              /* so no need to check later */
  1142.  
  1143. end           /*we may loop here several times, but eventually
  1144.                    the auto_names list will be exhausted */
  1145.  
  1146.  
  1147. do_verb:   nop   /* jump here avoids AUTONAME for POST and HEAD */
  1148. /* ---------- Process a standard (GET,POST, or HEAD) request  --------------- */
  1149.  
  1150.  
  1151. /* See if a "home_dir" flag (a ~) is present.  If so, replace
  1152. it with the "home_dir".  Note that home_dir is set above, and the replacementm
  1153. is literal -- there is NO checking of proper placement of /'s.  So,
  1154. be careful that your use of the ~ in request strings is consistent with
  1155. the value you give to home_dir */
  1156.  
  1157. parse var sel action '?' awords
  1158. foo=action
  1159. action=sref_replacestrg(action,'~',home_dir) ;
  1160. if foo<>action then say " Home_dir set in sel: " sel
  1161. if pos('?',sel)>0 then
  1162.     sel=action||'?'||awords
  1163.  else
  1164.      sel=action
  1165.  
  1166. /* used if this is a file */
  1167. parse var sel action '?' awords
  1168.  
  1169.  
  1170. /* .... Now carry out supported verbs (GET POST HEAD), or SPECIAL control */
  1171. /*   -- and check for cgi_bin calls */
  1172.  
  1173. /* first, see if cgi-bin call (and cgi-bin emulation is on */
  1174.  
  1175. if  (abbrev(translate(sel),'CGI-BIN')=1) & (cgi_bin_dir<>0)   & (verb="GET" | verb="POST") then do
  1176.  
  1177.  
  1178. /* note: we convert cgi-bin/mapimage calls to /mapimage -- this assumes
  1179.  that the .map file will be in xxx/yyy.zzz (when sel is cgi-bin/mapimage/xxx/yyy.zzz)
  1180.  We may change this later */
  1181.  
  1182.   if abbrev(translate(sel),'CGI-BIN/MAPIMAGE') then
  1183.      sel=delstr(sel,1,8)    /* drop the cgi-bin/ */
  1184.   else do
  1185.       selt=translate(sel,' ','\/')
  1186.  
  1187.       what1=alias_action(word(selt,2))
  1188.       parse  var what1 gotit new_dir
  1189.       if gotit<>0 & new_dir<> "" then do
  1190.           cgi_bin_dir=strip(translate(new_dir,'\','/'),'t','\')
  1191.       end
  1192.       cmdfile=dostempname(tempfile_dir||'\f????.cmd')
  1193.      gotit=sref_docgi(cgi_bin_dir, sel, verb, clientname0, filter_name, serverport , ,
  1194.         servername, protocol, dir, who,tempfile,cmdfile)
  1195.  
  1196.      if post_filter=0 then
  1197.                return gotit
  1198.       else do
  1199.                 gotit
  1200.                 post_filter_message="CGI-BIN call: "||sel
  1201.                 signal  do_post_filter
  1202.       end
  1203.   end           /* not a cgi-bin/mapimage call */
  1204.  
  1205. end             /* is a cgi-bin call */
  1206.  
  1207.  
  1208. /* Second, Check  if it is a special 'control' requests.
  1209. For these, the verb is ignored (though would usually be GET).
  1210. Note that this must be in the main, since it returns to the
  1211. goserve server directly. Also, we may need to check on privileges
  1212. */
  1213. if left(sel,1)='!' then do
  1214.    parse var sel sel '?' args  /* there may be some arguments */
  1215.   sel=translate(sel)
  1216.  
  1217.   select
  1218.     when sel='!PING'       then do
  1219.         post_filter_message="Ping request"
  1220.        'STRING Ping!'
  1221.     end
  1222.  
  1223.     when sel="!MACRO" then do
  1224.        if ispriv("CONTROL")=1 then do
  1225.           call lineout tempfile, '<!doctype html public "-//IETF//DTD HTML 2.0//EN">'
  1226.           call lineout tempfile, "<html><head><title>SRE-Filter Macrospace Update </title>"
  1227.           call lineout tempfile, "</head>"
  1228.           call lineout tempfile, "<body><h1> Updating SRE-Filter macrospace...</h1>"
  1229.           if macrospace_input=1 then do
  1230.              okay=sref_load_mac(servdir,user_File,initfilt_file,repstrgs_File, ,
  1231.                  alias_file,interpret_file,virtual_file,access_file)
  1232.              post_filter_message='Macrospace updated '
  1233.           end
  1234.           else do
  1235.               post_filter_message='Macrospace update not permitted '
  1236.           end
  1237.           call lineout tempfile, post_filter_message
  1238.           call lineout tempfile, " </body> </html> "
  1239.           call lineout tempfile
  1240.           'FILE ERASE TYPE text/html NAME ' tempfile
  1241.        end
  1242.        else do
  1243.              post_filter_message="!Special request denied: "||sel
  1244.            'FILE ERASE TYPE text/html NAME ' tempfile
  1245.        end
  1246.     end
  1247.  
  1248.     when sel='!STATISTICS' then  do
  1249.       post_filter_message="CONTROL Statistics request"
  1250.       'CONTROL STATISTICS'
  1251.     end
  1252.  
  1253.     when left(sel,5)='!HOST' then do
  1254.        if args<> " " then sel="!HOST?"||args
  1255.        sel=translate(sel,' ','?+&')
  1256.        sel=word(sel,2)
  1257.        host(sel) /* a ping */
  1258.        post_filter_message="Host request"
  1259.     end
  1260.  
  1261.     when sel='!SAVE'       then
  1262.        if ispriv("CONTROL")=1 then do
  1263.            'CONTROL MOVEAUDIT'
  1264.             post_filter_message="Control Moveaudit"
  1265.        end
  1266.        else do
  1267.              post_filter_message="!Special request denied: "||sel
  1268.            'FILE ERASE TYPE text/html NAME ' tempfile
  1269.        end
  1270.  
  1271.     when sel='!RESET'   then
  1272.          if ispriv("CONTROL")=1 then do
  1273.             'CONTROL RESET ALL'
  1274.              post_filter_message="Control Reset all"
  1275.  
  1276.          end
  1277.          else do
  1278.               post_filter_message="!Special request denied: "||sel
  1279.              'FILE ERASE TYPE text/html NAME ' tempfile
  1280.         end
  1281.  
  1282.     when sel='!VARIABLE'   then
  1283.           if ispriv("SUPERUSER")=1 then  do
  1284.               show_vars(args)  /* call as routine-- needs globals */
  1285.               post_filter_message="Variable display"
  1286.          end
  1287.          else do
  1288.               'FILE ERASE TYPE text/html NAME ' tempfile
  1289.                post_filter_message="!Special request denied:"||sel
  1290.          end
  1291.  
  1292.      when sel="!ASKMESSBOX" then do
  1293.           if ispriv("VIEWMESS") then do
  1294.               post_filter_message='Message box access'
  1295.               boy=what_messbox(args)
  1296.           end
  1297.           else
  1298.             post_filter_message='Message box access denied'
  1299.  
  1300. /* tempfile is an error message (if not ispriv), or a list of known mailboxes */
  1301.          'FILE ERASE TYPE text/html NAME ' tempfile
  1302.  
  1303.          end
  1304.  
  1305.       when sel="!VIEWMESS" then do
  1306.             post_filter_message='Message box viewing'
  1307.              doit=viewmessage(args)  /* do it is the goserv command */
  1308.              doit
  1309.          end
  1310.  
  1311.       otherwise do
  1312.            post_filter_message='Special request processing unknown:'||sel
  1313.            dog= response('badreq', 'asked for unknown Special control "'sel'"')
  1314.            dog
  1315.       end
  1316.  
  1317.     end                 /*select */
  1318.     if post_filter=0 then
  1319.         return ' '
  1320.     else
  1321.         signal do_post_filter
  1322.  
  1323.  end                    /* Special ! requests */
  1324. /* end of   ! special requests   **********/
  1325.  
  1326.  
  1327. /* Now, do the verbs !  */
  1328.  
  1329. select
  1330.  
  1331. /*  ------ HEAD REQUESTS  ------- */
  1332.   when verb='HEAD' then do
  1333.        parse var sel action '?' awords
  1334.         file=do_virtual_file(dir,action)          /* virtual_dir. is exposed */
  1335.         if file="!MOVED" then do
  1336.            post_filter_message="HEAD request: "||seloriginal
  1337.            signal do_post_filter
  1338.         end
  1339.  
  1340.         if file=0 then do
  1341.           if post_filter=0 then
  1342.               return not_found_response(seloriginal,'Document not found '," ")
  1343.           else do
  1344.                 dog=not_found_response(seloriginal,'Document not found '," ")
  1345.                 dog
  1346.                 post_filter_message="HEAD request: Document not found: "||seloriginal
  1347.                 signal do_post_filter
  1348.            end
  1349.        end
  1350.        else do
  1351.            if auto_header<>"NO" then do
  1352.               mtype=sref_mediatype(file)
  1353.               if mtype="text/html" then do
  1354.                  foo= do_auto_header(file,0)     /* do_auto_header will generate the responses */
  1355. /****************** 
  1356.   Perhaps readd this later?
  1357.                  'HEADER DROP Content-Length:'
  1358.                   asimov=chars(file)-1
  1359.                  'HEADER ADD Content-Length:'asimov
  1360. ***************************************************/
  1361.               end
  1362.            end
  1363.  
  1364.            if post_filter=0 then
  1365.                return 'NODATA'
  1366.            else do
  1367.                 'NODATA'
  1368.                 post_filter_message="Head request "
  1369.                 signal  do_post_filter
  1370.            end
  1371.        end
  1372.     end
  1373.  
  1374.  
  1375. /* -------- GET REQUESTS ---------*/
  1376. /*  Simple transfer of files (no forms, etc. involved) must use GET verb */
  1377. /*  Suggestion: to be safe, files subject to server side includes (ssi) should be syntatically
  1378.     correct HTML documents, even if no ssi's occur (thus protecting against
  1379.     errors, however unlikely, in the ssi routine).  The best way
  1380.     to achieve this is to set your "delimiters" to be <!--  and -->, and
  1381.     to NOT have spaces in your keyphrase:
  1382.        Example: <!-- REPLACE:DATE -->
  1383.     (in processing ssi's, this filter treats : = and spaces equivalently)
  1384. */
  1385.  
  1386.  
  1387.   when verb='GET'  then do               /* GET is used for file transfers */
  1388.       parse var sel action '?' awords
  1389.       action=TRANSLATE(strip(action))   /* CAP AND Rid  spaces */
  1390.  
  1391. /* There are 4 classes of GET requests supported:
  1392.    1) Simple file name  eg;  /ZIPFIP/ZIPFIP.HTM
  1393.         File is retrived, with possible ssi's
  1394.     2) File name with OPTIONS, eg; /OVERVIEW.HTM?From+ZIPFIP+main+page
  1395.         File is retrieved, with possible ssi's (some of which may use these OPTIONS
  1396.     3) Form name with parameters, eg; /CALC/DOCALC?12-34%2B51
  1397.          sref_getpost is called with appropriate arguments
  1398.     4) Mappable image (ISMAP) response.  URL must include the
  1399.        ismap_url string (say, MAPIMAGE/) and end with a ?xx,yy.
  1400.        Eg  ISMAPDIR/US/USMAP?41+239
  1401.  
  1402.        Note: ISINDEX type searchable-index requests are identical in
  1403.            appearance to case 2.  To avoid this problem, use the alias_file
  1404.            mechanism (described above) to convert to a class 3
  1405.            ( "form name" SEL) that requests DOSEARCH
  1406. */
  1407.  
  1408.  
  1409.       if  pos('?',sel)=0 then           /* no argument list, must be case 1 */
  1410.           jcase=1
  1411.  
  1412.       else do                   /*arguments, class 2,3, or 4 */
  1413.  
  1414.          attype=sref_mediatype(action)
  1415.          if attype='text/html' then do  /*  CLASS 2 ? */
  1416.              jcase=2            /* class 2: html with "OPTIONS" */
  1417.              optlist.0= make_optlist(awords)    /* optlist. is exposed */
  1418.          end
  1419.          else do                        /* CLASS 3 or 4 */
  1420.               jcase=3              /* case 3: form */
  1421.               if pos(translate(ismap_url),action) > 0 then
  1422.                  jcase=4                        /* class 4: ismap */
  1423.          end
  1424.        end
  1425.  
  1426. /*  A file (perhaps with options) transfer*/
  1427.       if jcase < 3 then  do
  1428.          file=do_virtual_file(dir,action)          /* virtual_dir. is exposed */
  1429.          if file="!MOVED" then do
  1430.            post_filter_message="GET request: "||seloriginal
  1431.            signal do_post_filter
  1432.          end
  1433.  
  1434.          if file=0 then do
  1435.              if auto_name=" " | is_public=1 then  do /* no directory specific defaults */
  1436.                  if post_Filter=0 then do
  1437.                      return not_found_response(seloriginal,' Document not found ',not_found_url)
  1438.                  end
  1439.                  else do
  1440.                       dog= not_found_response(seloriginal,' Document not found ',not_found_url)
  1441.                       dog
  1442.                       post_filter_message="Document not found "
  1443.                       signal do_post_filter
  1444.                   end
  1445.              END
  1446.              else do        /* more directory specific defaults to test? */
  1447.                 sel=selautoname
  1448.                 signal goautoname
  1449.              end
  1450.          end            /* file = 0 */
  1451.  
  1452. /* File exists! */
  1453.  
  1454. /* Do server side includes ?  */
  1455. /*accept_range=0*/
  1456.  
  1457.       atype=sref_mediatype(file)
  1458.       if atype<>'text/html' then do   /* NOTE: Includes ONLY for html type files */
  1459.            dog=1
  1460.            if accept_range=1 then do
  1461.                 dog=process_range(file,atype)
  1462.            end
  1463.  
  1464.            if accept_range<=0 | dog=0 then do
  1465.                dog='FILE TYPE '||sref_mediatype(file)||" "|| cache_status ||' NAME '|| file
  1466.            end
  1467.            fooo=stream(file,'c','close')
  1468.  
  1469.            if post_filter=0 then do
  1470.                  dog
  1471.                  return ' '
  1472.            end
  1473.            else do
  1474.                   dog
  1475.                   post_filter_message='Non-HTML File sent:'||file
  1476.                   signal do_post_filter
  1477.            end
  1478.       end
  1479.  
  1480. /* else, make temp file with possible includes, or maybe not */
  1481.       docname=action  /* (might be used in do_includes */
  1482.       call do_includes file    /* many globals used, so call as a routine */
  1483.       dofile1=result
  1484.       if dofile1=0 then do /* no changes needed (or none attempted), send back requested file */
  1485.  
  1486.              dog=1
  1487.              if accept_range=1 then
  1488.                 dog=process_range(file,atype)
  1489.              if accept_range=0 | dog=0 then
  1490.                 dog='FILE TYPE ' ||sref_mediatype(file)||' '|| cache_status ||' NAME '|| file
  1491.  
  1492.              if auto_header="ALWAYS" then
  1493.                  foo= do_auto_header(file,0)
  1494.  
  1495.              if post_filter=0 then do
  1496. /*                foo=send_bits(file) */
  1497.                  dog
  1498. /*say " returning "*/
  1499.                 return ' '
  1500.              end
  1501.              else do
  1502.                  dog
  1503.                  post_filter_message='HTML File sent:'||file
  1504.                  signal do_post_filter
  1505.              end
  1506.  
  1507.        end
  1508.        else  do    /* changes were made/results returned, using VAR ,in do_includes */
  1509.             if post_filter=0 then do
  1510.                 return ' '
  1511.             end
  1512.             else do
  1513.                  post_filter_message='HTML File sent (with ssi):'||file
  1514.                  signal do_post_filter
  1515.             end
  1516.       end
  1517.  
  1518.       end                /* jcase < 3, file transfer (with includes? */
  1519.  
  1520. /* Note on cache_status.  If logon required for everyone/always, or
  1521.       if inhouse, then do NOT cache this file (if cached, a lucky requester
  1522.         could get it even if not allowed.  Note that stuff with server side
  1523.         includes is NEVER cached (it's returned as a VAR, which GOSERVE does
  1524.         not cache).
  1525.     Also, if byte range sent, no caching.
  1526.  
  1527. */
  1528.  
  1529. /*  -------------------------------------------------
  1530.          Else, it's the result from Image or Form (3 or 4)
  1531.     ... so call an external procedure to do it
  1532. */
  1533.  
  1534.  
  1535. /* is this a mappable image request */
  1536.      if jcase=4 then do
  1537.          mapfile0=sref_replacestrg(action,ISMAP_url,"")
  1538.          mapfile=do_virtual_file(dir,MAPFILE0,1)
  1539.  
  1540. /* note that this construction handles href="mapimage/bob.map" in
  1541.   file with url /work/hi.htm (which would generate call to url of 
  1542.   /work/mapimage/bob.map )
  1543. */    
  1544.         if file<>"!MOVED" then
  1545.             foo=sref_mapimage(mapfile,awords, servername, serverport, tempfile, dir, max_pointdist)
  1546.  
  1547.          if post_filter=0 then
  1548.              return   ' '      /* completion code invoked in mapimage */
  1549.          else do
  1550.              post_filter_message='Mappable image request:'||foo
  1551.              signal do_post_filter
  1552.          end
  1553.  
  1554.      end
  1555.  
  1556.  
  1557. /* else, jcase=3, ... it's an action request (i.e.; a FORM response) ... */
  1558. /* first, determine if any extra parameters are need, based on ACTION */
  1559.       infiles=access_file||','||user_file||','||virtual_file||','||alias_file||','||sendfile_file
  1560.       select
  1561.        when action="SENDFILE" then
  1562.                 params=allow_access||' '||macrospace_input
  1563.        when action="GETAFILE" then
  1564.                 params=allow_access||' '||no_getafile_control|| ' '||macrospace_input
  1565.        when action="GET_URL" | action="PUT_FILE" then
  1566.                 params=upload_dir||' '||upload_maxsize||' '||upload_Minfree||' '||upload_log
  1567.        when action="MESSAGE" then
  1568.           params=0
  1569.        when action="DOSEARCH"  then
  1570.            params=macrospace_input
  1571.        otherwise do                      /* add directory, info */
  1572.           ACTION=do_virtual_file(SERVdir,action,1)
  1573.           if action="!MOVED" Then do
  1574.              post_filter_message='GET request:'||action
  1575.              signal do_post_filter
  1576.           end
  1577.           params= macrospace_input
  1578.        END
  1579.       end
  1580.  
  1581. /* should we record ALL  GET / POST  requests ? */
  1582.      if no_processing<>1 then DO
  1583.           got1=sref_getpost(tempfile,ACTION,awords,verb,uri,who,    ,
  1584.                     servdir,messbox_dir,dir,tempfile_dir,     ,
  1585.                       webmaster,privset,params,infiles)
  1586.      END
  1587.      else
  1588.         got1=response(401,' Server side processing privileges not granted for: '||action)
  1589.       
  1590.     fpp=stream(tempfile,'c','close')
  1591.  
  1592.     if post_filter=0 then  do
  1593.          return got1  /* got1 is the file erase string */
  1594.      end
  1595.      else do
  1596.          got1
  1597.          post_filter_message='GET request:'||action
  1598.          signal do_post_filter
  1599.      end
  1600.  
  1601.    end /* get */
  1602.  
  1603. /* -------- POST REQUESTS ---------*/
  1604.  
  1605.   when verb='POST' then do              /** POST is used for forms */
  1606.  
  1607.  
  1608. /* Check for arguments.  Note that if no arguments, error. */
  1609.     drop awords
  1610.     'read body var awords'                    /* get the incoming data */
  1611.  
  1612.     if rc=-4 then                            /* body too large */
  1613.         if post_filter=0 then
  1614.              return response('badreq', 'sent too much data')
  1615.         else do
  1616.              dog= response('badreq', 'sent too much data')
  1617.              dog
  1618.              post_filter_message="POST error: too much data"
  1619.              signal do_post_filter
  1620.         end
  1621.     if rc<>0 then                            /* e.g., invalid HTTP header */
  1622.        if post_filter=0 then
  1623.            return response('badreq', 'sent data that could not be read')
  1624.        else do
  1625.            dog=response('badreq', 'sent data that could not be read')
  1626.            dog
  1627.            post_filter_message="POST error: could not read data "
  1628.            signal do_post_filter
  1629.         end
  1630.  
  1631.       ACTION=translate(sel)
  1632.  
  1633.       infiles=access_file||','||user_file||','||virtual_file||','||alias_file||','||sendfile_file
  1634.       select
  1635.          when action="SENDFILE" then
  1636.                 params=allow_access||' '||macrospace_input
  1637.          when action="GETAFILE" then
  1638.                 params=allow_access||' '||no_getafile_control|| ' '||macrospace_input
  1639.          when action="GET_URL" | action="PUT_FILE" then
  1640.                 params=upload_dir||' '||upload_maxsize||' '||upload_Minfree||' '||upload_log
  1641.          when action="MESSAGE" then
  1642.             params=0
  1643.          when action="DOSEARCH"  then
  1644.            params=macrospace_input
  1645.          otherwise do                      /* add directory, info */
  1646.             ACTION=do_virtual_file(SERVdir,action,1)
  1647.             if action="!MOVED" Then do
  1648.                post_filter_message='POST request:'||action
  1649.                signal do_post_filter
  1650.             end
  1651.             params= macrospace_input
  1652.          end
  1653.       end
  1654. /* should we record ALL  GET / POST  requests ? */
  1655.  
  1656.      if no_processing<>1 then DO
  1657.          got1=sref_getpost(tempfile,ACTION,awords,verb,uri,who,    ,
  1658.                     servdir,messbox_dir,dir,tempfile_dir,     ,
  1659.                       webmaster,privset,params,infiles)
  1660.      END
  1661.      else
  1662.         got1=response(401,' Server side processing privileges not granted for: '||action)
  1663.  
  1664.     fpp=stream(tempfile,'c','close')
  1665.  
  1666.      if post_filter=0 then
  1667.          return got1
  1668.      else do
  1669.          got1
  1670.          post_filter_message='POST request:'||sel
  1671.          signal do_post_filter
  1672.      end
  1673.  
  1674.  
  1675.   end /* post */
  1676.  
  1677.  
  1678.   otherwise do
  1679.       if post_filter=0 then
  1680.           return response('badreq', 'sent an unknown verb "'verb'"')
  1681.       else do
  1682.           dog=response('badreq', 'sent an unknown verb "'verb'"')
  1683.           dog
  1684.           post_filter_message="Sent an unknown verb "
  1685.           signal do_post_filter
  1686.       end
  1687.  
  1688.  
  1689.   end /* select verb */
  1690.  
  1691.  
  1692.  
  1693. do_post_filter:
  1694.   IF POST_FILTER=0 THEN RETURN ' '
  1695.   signal on syntax name bad2
  1696.   signal on error name bad2
  1697.   yow='foo3='||postfilter_name||'(post_filter_message,source0,request0,seloriginal,tempfile,smtp_gateway)'
  1698.   interpret yow
  1699.   signal off syntax;  signal off error
  1700.   return ' '
  1701. bad2:
  1702.   signal off syntax; signal off error
  1703.   say " Error in post_filter routine "
  1704.   return ' '
  1705.  
  1706.  
  1707. /* ---------------- END of MAIN routine [cannot reach here] -------------- */
  1708. /*************************************************************************/
  1709.  
  1710. /* ============================================================= */
  1711. /* routines to read in (from file or macrospace) initialization files */
  1712. /* ============================================================= */
  1713.  
  1714. /* ---------------------------------------------- */
  1715. /* read an .in file, or it's macrospace version, into filelines. stem
  1716. variable
  1717. atype:
  1718.   INITFILT, REPSTRGS, INTERPRET,  ALIASES,  USER
  1719.  */
  1720. /* ---------------------------------------------- */
  1721.  
  1722. file_or_macro:
  1723. parse upper arg atype
  1724.  
  1725. somestuff=0
  1726. crlf='0d0a'x
  1727. select                  /* which .in file */
  1728.   when atype="INITFILT" then get_file=initfilt_file
  1729.   when atype="REPSTRGS" then get_file=repstrgs_file 
  1730.   when atype="INTERPRET" then get_file=interpret_file 
  1731.   when atype="ALIASES" then get_file=alias_file  
  1732.   when atype="VIRTUAL" then get_file=virtual_file 
  1733.   when atype="ACCESS" then get_file=access_file
  1734.   when atype="USER" then get_file=user_file
  1735.   otherwise  do
  1736.      filelines.0=0
  1737.      return 0
  1738.   end
  1739. end
  1740.  
  1741. /* skip if suppresion of mspace for input */
  1742. if macrospace_input=0 then signal no_macro2
  1743.  
  1744. signal on error name no_macro           /* which macro */
  1745. signal on syntax name no_macro
  1746. gotit=0
  1747. select 
  1748.   when atype="INITFILT" then somestuff=sref_macro_initfilt()
  1749.   when atype="REPSTRGS" then  somestuff=sref_macro_repstrgs()
  1750.   when atype="INTERPRET" then do
  1751.        somestuff=sref_macro_interpret()
  1752.   end
  1753.   when atype="ALIASES" then   somestuff=sref_macro_aliases()
  1754.   when atype="VIRTUAL" then  somestuff=sref_macro_virtual()
  1755.   when atype="ACCESS" then somestuff=sref_macro_access()
  1756.   when atype="USER" then somestuff=sref_macro_user()
  1757.   otherwise  somestuff=0
  1758. end
  1759. gotit=1
  1760. no_macro:
  1761.  
  1762. if gotit=0 then 
  1763.   say "Could not load from macrospace:"atype   /* else, signal error */
  1764.  
  1765. no_macro2:                      /* skip here if macrospace_input=no */
  1766. signal off error ; signal off syntax
  1767.  
  1768. /* get date of file */
  1769. eek=sysfiletree(translate(get_file,'\','/'),'gosh','FT')
  1770. if gosh.0=0 then do  /* no file */
  1771.   say " Missing initialization file = " get_file atype
  1772.   filelines.0=0
  1773.   return 0
  1774. end                        
  1775. parse var gosh.1  atime .
  1776. filedate=sref_juldate('F',atime)
  1777.  
  1778. /* get date of macro_space version */
  1779. if somestuff<>0 then
  1780.    parse var somestuff macrodate "," somestuff
  1781. else
  1782.    macrodate=0
  1783.  
  1784. if transaction=1 then macrodate=0       /* a hack-- on first tranaction re-read*/
  1785.  
  1786. /* use newer one */
  1787. if filedate>=macrodate then do  /* if file newer then macrospace, use file */
  1788.    if macrospace_input=1 then
  1789.       say " WARNING: Need to update  macro space:" atype ", file macro " filedate macrodate
  1790.    ause=fileread(get_file,'templines',,'E')
  1791.    if (ause=0) then  do               /*no such file,*/
  1792.       say " Unavailable file: " get_file atype
  1793.       filelines.0=0
  1794.       return 0
  1795.    end                        /* so no user defined replacement strings*/
  1796.    isfrom=" file "
  1797. end
  1798. else do                 /* use stuff stored in macro space */
  1799.   i1=0
  1800.   do until somestuff=""
  1801.      i1=i1+1
  1802.      parse var somestuff templines.i1 (crlf) somestuff
  1803.   end
  1804.   templines.0=i1
  1805.   isfrom=" macro "
  1806. end
  1807.  
  1808. iff=0
  1809. do mm=1 to templines.0
  1810.   aline=strip(templines.mm)
  1811.   if left(aline,1)=';' | aline="" then iterate
  1812.  
  1813.   iff=iff+1
  1814.   filelines.iff=sref_replacestrg(aline,"`~","'",'ALL')
  1815. end
  1816. filelines.0=iff
  1817. return iff
  1818.  
  1819.  
  1820.  
  1821.  
  1822. * --------------------------------------------------- */
  1823. /* Read / interpret initfilt (from file or macrospac */
  1824. /* --------------------------------------------------- */
  1825. get_initfilt:
  1826.  
  1827. call file_or_macro 'INITFILT'
  1828.  
  1829.  
  1830. /*Allow for gratuitous coding calamity by clumsy users */
  1831.  
  1832.  
  1833. mm=0 ; nerrs=0
  1834. iat1: nop
  1835. if mm>=filelines.0 then do
  1836.  
  1837.    signal off syntax
  1838.    signal off error
  1839.    signal off failure
  1840.    return nerrs
  1841. end
  1842.  
  1843. mm=mm+1
  1844. signal on syntax name foobar1
  1845. signal on error name foobar1
  1846. signal on  failure name foobar1
  1847.  goo=filelines.mm
  1848.  ok=0
  1849.  interpret goo
  1850.  ok=1
  1851.  
  1852. foobar1:
  1853. if ok=0 then do
  1854.    nerrs=nerrs+1
  1855.    say " Error in initfilt: "goo
  1856.    audit" Error in initfilt: "goo
  1857.  
  1858. end
  1859.  
  1860. signal iat1
  1861.  
  1862. return 0
  1863.  
  1864.  
  1865. * --------------------------------------------------- */
  1866. /* Read interpret mini-code-blocks (from file or macrospac */
  1867. /* --------------------------------------------------- */
  1868. get_interpret:
  1869.  
  1870. call file_or_macro 'INTERPRET'
  1871.  
  1872. if filelines.0 =0 then 
  1873.   return
  1874. else
  1875. interp_data=filelines.1
  1876. do mm=1 to filelines.0
  1877.   interp_data=interp_data||crlf||filelines.mm
  1878. end
  1879.  
  1880. return filelines.0
  1881.  
  1882.  
  1883. /* -------------------------------------------- */
  1884. /* Setup replacestrg lines */
  1885.  
  1886. setup_replines:         /* routine to setup replines. stem variable */
  1887.  
  1888. call file_or_macro 'REPSTRGS'
  1889.  
  1890. /* Got info, so create the replines. stem variable */
  1891. iat=0
  1892.   do ii =1 to filelines.0
  1893.      aline=strip(filelines.ii)
  1894.      parse var aline alabel avalue
  1895.      kgot=0
  1896.      do jj=1 to iat
  1897.          if alabel=replines.jj.label then do                    /* multi lines replacements? */
  1898.              replines.jj.value=replines.jj.value||crlf||avalue
  1899.              kgot=1
  1900.              leave
  1901.          end
  1902.      end
  1903.      if kgot=0 then do                          /* new entry */
  1904.             iat=iat+1
  1905.             replines.iat.label=alabel
  1906.             replines.iat.value=avalue
  1907.      end
  1908.   end
  1909. replines.0=iat
  1910. return iat
  1911.  
  1912.  
  1913.  
  1914. /* ---------------------- Endo  of access control routines -------------------- */
  1915. /*****************************************************************************/
  1916.  
  1917. /**************************************************************************/
  1918. /* -------------------------Generic response stuff, from GOFILTER.80- */
  1919.  
  1920. /* ----------------------------------------------------------------------- */
  1921. /* RESPONSE: Standard [mostly error] responses.                            */
  1922. /* ----------------------------------------------------------------------- */
  1923. /* This routine should stay in the main filter program.                    */
  1924. /* Arguments are: response type and extended message information.          */
  1925. /* It returns the GoServe command to handle the result file.               */
  1926. response: procedure expose tempfile  seloriginal request0 source0
  1927.   parse arg request, message
  1928.   select
  1929.     when request='badreq'   then use='400 Bad request syntax'
  1930.     when request='notfound' then use='404 Not found'
  1931.     when request='forbid'   then use='403 Forbidden'
  1932.     when request='unauth'   then use='401 Unauthorized'
  1933.     otherwise do
  1934.         use='404 Not found'
  1935.         say 'weird response ' request message
  1936.       end
  1937.     end  /* Add others to this list as needed */
  1938.  
  1939.  
  1940.   /* Now set the response and build the response file */
  1941.   'RESPONSE HTTP/1.0' use     /* Set HTTP response line */
  1942.   parse var use code text
  1943.   call lineout tempfile, '<!doctype html public "-//IETF//DTD HTML 2.0//EN">'
  1944.   call lineout tempfile, "<html><head><title>"text"</title></head>"
  1945.   call lineout tempfile, "<body><h2>Sorry...</h2>"
  1946.   call lineout tempfile, "<p>The request from your Web client" message"."
  1947.   call lineout tempfile, "<hr><em>HTTP response code:</em>" code '['text']'
  1948.   call lineout tempfile, "<br><em>From server at:</em>" servername()
  1949.   call lineout tempfile, "<br><em>Running:</em>" server()
  1950.   call lineout tempfile, "</body></html>"
  1951.   call lineout tempfile  /* close */
  1952.   return 'FILE ERASE TYPE text/html NAME' tempfile
  1953.  
  1954. /* ----------------------------------------------------------------------- */
  1955. /* NOT_FOUND_RESPONSE: Return a "not found" response,
  1956. .                       with optional message         */
  1957. /* ----------------------------------------------------------------------- */
  1958. not_found_response: procedure expose tempfile  source0 seloriginal request0
  1959.   parse arg request, message , message2
  1960.  
  1961.  
  1962.  
  1963.   'RESPONSE HTTP/1.0 404 Not found'     /* Set HTTP response line */
  1964.   call lineout tempfile, '<!doctype html public "-//IETF//DTD HTML 2.0//EN">'
  1965.   call lineout tempfile, "<html><head><title>"message"</title></head>"
  1966.   call lineout tempfile, "<body><h2>Sorry...</h2>"
  1967.   call lineout tempfile, "<p>Unable to complete the request from your Web client:" request"."
  1968.   call lineout tempfile,  "<BR> Problem: " message
  1969.   call lineout tempfile, "<p> " message2
  1970.   call lineout tempfile, "<p><em>From server at:</em>" servername()
  1971.   call lineout tempfile, "<br><em>Running:</em>" server()
  1972.   call lineout tempfile, "</body></html>"
  1973.   call lineout tempfile  /* close */
  1974.   return 'FILE ERASE TYPE text/html NAME' tempfile
  1975.  
  1976.  
  1977. /* ----------------------------------------------------------------------- */
  1978. /* MOVED: Return a 'moved' response                                        */
  1979. /* ----------------------------------------------------------------------- */
  1980. /* This must be in the main filter program (uses PORT and TEMPFILE).       */
  1981. /* Argument is new URL or partial URI                                      */
  1982. /* It returns the GoServe command to handle the result file.               */
  1983. moved: procedure expose serverport tempfile  source0 seloriginal request0
  1984.   parse arg uri , mtype
  1985.   port=serverport
  1986.  
  1987.  
  1988.   if left(translate(uri),5)=='HTTP:' then /* got full URI */ url=uri
  1989.    else /* got partial URI */ do
  1990.     if port=80 then pp=''; else pp=':'port
  1991.     url='http://'servername()pp'/'uri        /* relocation */
  1992.     end
  1993.  
  1994.  
  1995.   /* Now set the response and build the response file */
  1996.    if mtype=301 then
  1997.       'RESPONSE HTTP/1.0 301 Moved Permanently'  /* Set HTTP response line */
  1998.    else
  1999.       'RESPONSE HTTP/1.0 302 Moved Temporarily'  /* Set HTTP response line */
  2000.   'HEADER ADD Location:' url
  2001.   call lineout tempfile, '<!doctype html public "-//IETF//DTD HTML 2.0//EN">'
  2002.   call lineout tempfile, "<html><head><title>Moved</title></head>"
  2003.   call lineout tempfile, "<body><h2>Document moved...</h2>"
  2004.   call lineout tempfile, "<p>This document has moved"
  2005.   call lineout tempfile, "<a href="""url""">here<a>."
  2006.   call lineout tempfile, "</body></html>"
  2007.   call lineout tempfile  /* close */
  2008.   return 'FILE ERASE TYPE text/html NAME' tempfile
  2009.  
  2010.  
  2011. /* ----------------------------------------------------------------------- */
  2012. /* Already completed (cache or prefilter. Record it and exit            */
  2013. /* ----------------------------------------------------------------------- */
  2014. done_it:                        /* need globals, so call as routine */
  2015.  parse arg status , amessage
  2016.     issent=0
  2017.     if datatype(status)<>'NUM' then status=0
  2018.     if status=0 then issent=completed()
  2019.     if (issent+status)=0 then return 0   /* otherwise exit */
  2020.  
  2021.     say " Completed or redirected: " amessage
  2022.     parse var sel action '?' awords
  2023.      return 1
  2024.  
  2025.  
  2026.  
  2027.  
  2028. ******************************************************************************/
  2029. /*-- DO_prefiltr: Call User Written pre-filter                  --**/
  2030. /******************************************************************************/
  2031.  
  2032. do_prefiltr: procedure expose source0 request0 seloriginal prefilter_name
  2033.   parse arg amessage
  2034.   signal on syntax name bad2a
  2035.   signal on error name bad2a
  2036.   yow='foo3='||prefilter_name||'(source0,request0,seloriginal,amessage)'
  2037.   interpret yow
  2038. /*  foo3=prefiltr(source0,request0,seloriginal,amessage)*/
  2039.   signal not2a
  2040. end
  2041.  
  2042. bad2a:
  2043.   signal off syntax
  2044.   signal off error
  2045.   say " Error in pre-filter routine " amessage
  2046.  
  2047. not2a: nop
  2048.  
  2049.  signal off syntax
  2050.  signal off error
  2051.  
  2052.  
  2053. return foo3
  2054.  
  2055.  
  2056.  
  2057. /* ----------------------------------------------------------------------- */
  2058. /* SEND_NON_DATADIR -- !TRANSFER -- Send a file not in the data directory               */
  2059. /* This is basically obsolete, but is retained for occassional use */
  2060. /* ----------------------------------------------------------------------- */
  2061.  
  2062. send_non_datadir: procedure expose tempfile source0 seloriginal  request0 request_ids 
  2063.                  
  2064. parse  arg action , aword
  2065.  
  2066. taction=translate(action)
  2067. if abbrev(taction,'!TRANSFER=')=1 then
  2068.    action=delstr(action,1,10)
  2069. else
  2070.  if abbrev(taction,'!TRANSFER')=1 then
  2071.     action=delstr(action,1,9)
  2072.  
  2073. do mm=1 to words(request_ids)
  2074.    action=sref_replacestrg(action,word(request_ids,mm),aword)
  2075. end
  2076. a=stream(translate(action,'\','/'),'c','query exists')
  2077. if a="" then do
  2078.      return not_found_response(seloriginal,' File not found ',' ')
  2079.  
  2080. end
  2081.  
  2082. file2=translate(action,'/','\')
  2083. return 'FILE TYPE ' sref_mediatype(a)  ' nocache NAME' file2
  2084.  
  2085.  
  2086.  
  2087. /* ----------------------------------------------------------------------- */
  2088. /* -- Convert an answer, in list, into 1 */
  2089. /* ----------------------------------------------------------------------- */
  2090. is_true:procedure
  2091. parse upper arg ans,anslist
  2092. if wordpos(ans,anslist)>0 then 
  2093.  return 1
  2094. else
  2095.  return 0
  2096.  
  2097.  
  2098. /* ----------------------------------------------------------------------- */
  2099. /* SHOWVARS: Show values of listed variables   */
  2100. /* ----------------------------------------------------------------------- */
  2101.  
  2102. show_vars:
  2103.  
  2104. parse arg alist
  2105.  
  2106.   call lineout tempfile, '<!doctype html public "-//IETF//DTD HTML 2.0//EN">'
  2107.  
  2108.   call lineout tempfile, "<html><head><title> SRE-FILTER variables </title>"
  2109.   call lineout tempfile, "</head>"
  2110.   call lineout tempfile, "<body><h2>Values of selected variables</h2>"
  2111.   call lineout tempfile,' <pre>'
  2112.   do forever
  2113.       parse var alist repargn '&' alist
  2114.       putme='n.a.'
  2115.       if repargn<>""  then
  2116.            if  symbol(repargn)="VAR"  then
  2117.              putme= value(repargn)
  2118.       call lineout tempfile, repargn '    =     '  putme
  2119.       if alist="" then leave
  2120.   end
  2121.   call lineout tempfile,' </pre>'
  2122.  
  2123.  
  2124.   call lineout tempfile, ' </body> </html> '
  2125.   call lineout tempfile
  2126.   return  ' FILE ERASE TYPE text/html NAME ' tempfile
  2127.  
  2128. /* ----------------------------------------------------------------------- */
  2129. /* Write response headers, expects an HTML file      */
  2130. /* ----------------------------------------------------------------------- */
  2131.  
  2132. do_auto_header: procedure
  2133. parse arg file , notfile
  2134.  
  2135. if notfile=0 then
  2136.    stuff=sref_grab_file(file,30)
  2137. else
  2138.    stuff=file                     /* if ssi's happened, already read file in */
  2139.  
  2140.  if stuff=0 | stuff="" then return 0
  2141.  
  2142. dowrite=0
  2143. do until stuff=""
  2144.  
  2145.     parse var stuff  p1 '<' tag '>' stuff
  2146.     if  translate(word(tag,1))="HEAD" then do   /* now in head !*/
  2147.             dowrite=1
  2148.             iterate
  2149.     end
  2150.     if dowrite=0 then iterate    /* wait till we get into head .. */
  2151.  
  2152.     if  translate(word(tag,1))="/HEAD" then  /* out of head, all done ! */
  2153.         leave
  2154.  
  2155. /* is it a LINK or an META HTTP-EQUIV ? */
  2156.     if  translate(word(tag,1))="LINK" then do
  2157.        isme=""
  2158.        do mm=2 to words(tag)
  2159.            isme=isme||word(tag,mm)
  2160.            IF MM<words(tag) then isme=isme||" ; "
  2161.        end
  2162.        'HEADER ADD WWW-Link:  '||isme
  2163.        iterate
  2164.     end
  2165.     if translate(word(tag,1))="META" then do
  2166.         parse var tag ameta atype '=' rest
  2167.         if translate(atype)="HTTP-EQUIV" then do
  2168.  
  2169.            parse var rest aval1 rest
  2170.            aval1=strip(aval1) ;
  2171.            aval1=strip(aval1,,'"')
  2172.  
  2173.            aval2=" "
  2174.            foo1=pos('CONTENT=',translate(rest))
  2175.            if foo1>0 then do
  2176.                  aval2=substr(rest,9) ; aval2=strip(aval2)
  2177.                 aval2=strip(aval2,'b','"')
  2178.            end
  2179.             foo1=aval1||': '||aval2
  2180.            'HEADER ADD '||foo1
  2181.           iterate
  2182.         end
  2183.     end
  2184. end
  2185.  
  2186.  return 0
  2187.  
  2188.  
  2189. /* -------------------------   End of generic response stuff --------- */
  2190. /*************************************************************************/
  2191.  
  2192.  
  2193. /*************************************************************************/
  2194. /* -------------------------------Server side include routines -------------- */
  2195.  
  2196. /* ----------------------------------------------------------------------- */
  2197. /* set up optlist -- the list of OPTIONS  */
  2198. /* ----------------------------------------------------------------------- */
  2199.  
  2200. make_optlist: procedure expose optlist. no_include
  2201. parse arg selinfo
  2202.  
  2203.    if no_include=1 then  do
  2204.         return 0
  2205.     end
  2206.  
  2207.    eek=0
  2208.    if selinfo<>0 then do                /* note we convert url's to regular ascii */
  2209.        selinfo=translate(selinfo, ' ', '+'||'090a0d'x)  /* Whitespace, etc. */
  2210.        selinfo=packur(selinfo)
  2211.  
  2212.        do until selinfo = " "
  2213.           eek=eek + 1
  2214.           parse var selinfo optlist.eek '&' selinfo
  2215.        end
  2216.  
  2217.     end
  2218.  
  2219.     return eek
  2220.  
  2221. /* ----------------------------------------------------------------------- */
  2222. /* Main routine for doing server side includes (ssi's)
  2223. . We first read the candidate file into a big array.
  2224. .  Then check for existence of include types.
  2225. .  If none (or no_include=yes), then return 0 -- which means
  2226. .      "go ahead and return the default document "
  2227. .
  2228. .  Otherwise, add headers.n   right after the  the (first) <BODY> entry.
  2229. .               add footers.n to the portion right BEFORE the (last) </BODY> entry.
  2230. .  and
  2231.        see if these are legit keyphrases, and process them..
  2232. ,
  2233. ,  When no more candidates, return a 1.
  2234. ,  Note that 1 means "I've returned the results as a VAR, so we're done.
  2235. .  (I could use an EXIT here, but i let the main routine exit for me )
  2236. .
  2237. */
  2238. /* ----------------------------------------------------------------------- */
  2239.  
  2240. do_includes:                            /* many globals, so call as routine */
  2241.  
  2242.  parse arg tfile
  2243.  crlf='0d0a'x
  2244.  
  2245.  if no_include=1 then  /* don't bother, just return original file */
  2246.         return 0
  2247.  
  2248.   bigin=sref_grab_file(tfile,30)
  2249.   if bigin=0 | bigin="" then do              /*problem opening ! */
  2250.       say " Could not open file for includes : " tfile
  2251.       return 0          /* just send back file as is */
  2252.   end
  2253.  
  2254.   if c2d(right(bigin,1))=26 then
  2255.       bigin=left(bigin,length(bigin)-1)
  2256.  
  2257.  
  2258.   tbigin=translate(bigin)
  2259.  
  2260.   inctype.1="INTERPRET"
  2261.   inctype.2="OPTION"
  2262.   inctype.3="INCLUDE"
  2263.   inctype.4="REPLACE"
  2264.   inctype.5="SELECT"
  2265.    i5=5
  2266.   if cgi_bin_dir<>0 then do
  2267.     inctype.6='#'
  2268.     i5=6
  2269.   end
  2270.  
  2271.   do mm=1 to i5
  2272.      j.mm=pos(inctype.mm,tbigin)
  2273.   end
  2274.  
  2275.   apre=1 ;  apost=1
  2276.  
  2277.   if symbol('headers.1')<>"VAR" | headers.1=0 then  apre=0
  2278.   if symbol('footers.1')<>"VAR" | footers.1=0 then  apost=0
  2279.  
  2280. /* note that j.i may or may not be in a keyphrase! */
  2281.  booger=apre+apost; do iik=1 to i5 ; booger=booger+j.iik ; end
  2282.  
  2283. /* NO include keyphrases -- so send it (note we could use a VAR with bigin,
  2284.  but this complicates caching and generates an expires inappropriately) */
  2285. if booger = 0 then  do  
  2286.     return 0
  2287. end
  2288.  
  2289.  
  2290. /* add pre or post blocks if they have been specified (typically in initfilt) */
  2291.   if apre=1 then do
  2292.       m=1
  2293.       preadd=""
  2294.       do until symbol('headers.m')<>"VAR"
  2295.          if headers.m="" then leave
  2296.          preadd=preadd||headers.m||crlf
  2297.          m=m+1
  2298.      end
  2299.      bigin=sref_insert_block(bigin,'BODY',preadd,1,'<','>')
  2300.   end
  2301.   if apost=1 then do
  2302.        m=1
  2303.        postadd=""
  2304.        do until symbol('footers.m')<>"VAR"
  2305.           if footers.m="" then leave
  2306.           postadd=postadd||footers.m||crlf
  2307.           m=m+1
  2308.       end
  2309.       bigin=sref_insert_block(bigin,'/BODY',pOSTadd,0,'<','>')
  2310.   end
  2311.  
  2312. /* check for "send in pieces "  -- requires No retain_bad_keyphrase,
  2313. no fix_expire,  no 2nd delimiter, and no auto_header */
  2314.  send_piece=0
  2315.  if symbol('delim_1.2')<>"VAR" |  symbol('delim_2.2')<>"VAR" | ,
  2316.            delim_1.2=0 | delim_1.2="" then do
  2317.     if retain_bad_keyphrases=0 & auto_header<>"ALWAYS" & fix_expire=0 then do
  2318.           send_piece=1
  2319.           'SEND TYPE text/html as ' file
  2320.     end
  2321.  end
  2322.  
  2323.  
  2324. /* now start processing  bigin */
  2325. nsubs=0                 /* # of substitutions encountered */
  2326. totinc=0 ; badints=0  ; goodints=0
  2327.  
  2328. /* For flexibility, we process this for each set of "keyphrase delimiters",
  2329. where set k=1..K is defined using delim_1.k and delim_2.k (typically set
  2330. in initfilt) */
  2331.  
  2332. ithdelim=1
  2333. adelim1=delim_1.ithdelim
  2334. adelim2=delim_2.ithdelim
  2335. if adelim1="" | adelim2="" then return 0  /* bad initial delimiter -- don't do includes */
  2336.  
  2337. one_more_scan:          /* jump here for multiple delimiters sets */
  2338. outbig=''
  2339.  
  2340. do forever                      /* done when done */
  2341.    parse var bigin t1 (adelim1) in1 (adelim2) bigin
  2342.  
  2343.    if send_piece=1 & t1<>"" then do
  2344.      'VAR NAME T1 '
  2345.    end
  2346.    else do
  2347.       outbig=outbig||t1
  2348.    end
  2349.  
  2350.    if in1="" & bigin="" then leave
  2351.  
  2352. /* see if in1 is one of the inctypes (inctypes are aka keywords)*/
  2353.   in2=translate(in1)
  2354.   in2=translate(in2,' ','=:;')    /* space is the generic seperater */
  2355.  
  2356.   aninc=0 ; more2=0
  2357.                   /* 2 words, is first one of our keywords ? */
  2358.   do mm=1 to i5
  2359.      if abbrev(word(in2,1),inctype.mm)=1 then  do     /* it's the mm'th inc type */
  2360.         aninc=mm
  2361.         if mm>1 & mm<5 then do  /* not interpret or select */
  2362.            thearg=word(in2,2)
  2363.         end
  2364.         else do
  2365.            if mm=1 then do
  2366.               foo=pos('INTERPRET',translate(in1))
  2367.               thearg=substr(in1,foo+9)
  2368.               more2=1
  2369.           end
  2370.           if mm=6 then do
  2371.               foo=pos('#',translate(in1))
  2372.               thearg=substr(in1,foo+1)
  2373.               more2=1
  2374.            end
  2375.            if mm=5 then do
  2376.               foo=pos('SELECT',translate(in1))
  2377.               thearg=substr(in1,foo+6)
  2378.               more2=1
  2379.            end
  2380.         end
  2381.         leave                /* leave this lttle loop */
  2382.      end
  2383.   end
  2384.  
  2385. /* Not a keyword, or a syntactically bad keyphrase    */
  2386.  if aninc=0 | (aninc>0 & words(in2)<>2 & more2=0 & retain_bad_keyphrases=1) then do
  2387.        if bigin<>"" then
  2388.             t1=adelim1||in1||adelim2  /* leave it be */
  2389.        else
  2390.             t1=adelim1||in1  /* openended "comment" */
  2391.       if send_piece=1 then do
  2392.             'VAR NAME T1'
  2393.       end
  2394.       else
  2395.            outbig=outbig||t1
  2396.       iterate
  2397.   end
  2398.  
  2399.  
  2400. /* if here, we have a (possibly) good keyphrase */
  2401.    nsubs=nsubs+1
  2402.    select
  2403.  
  2404.      when inctype.aninc='#' then do
  2405.            putme=do_cgi_include(thearg)
  2406.      end
  2407.  
  2408.  
  2409.      when inctype.aninc="INTERPRET" then do
  2410.           putme=line_interpret(thearg)
  2411.           if putme="" then
  2412.               badints=badints+1
  2413.           else
  2414.               goodints=goodints+1
  2415.      end
  2416.  
  2417.      when  inctype.aninc="OPTION" then do
  2418.  
  2419.          putme=line_message(thearg)
  2420.  
  2421.      end
  2422.  
  2423.      when inctype.aninc="INCLUDE" then do
  2424.  
  2425.          putme=line_include(thearg)
  2426.          if putme<>"" then
  2427.              totinc=length(putme)+totinc
  2428.      end
  2429.  
  2430.      when inctype.aninc="REPLACE" then do
  2431.           putme=line_replace(thearg)
  2432.      end
  2433.  
  2434.      when inctype.aninc="SELECT" then do
  2435.  
  2436.         useit=do_select(thearg)
  2437.         putme=""
  2438.         if useit=0 then do              /* 0=EXCLUDE it ! */
  2439.  
  2440. /* scan for next SELECT, and delete everything in between */
  2441.           bigin=bigin
  2442.           putme=""
  2443.           do until bigin=""
  2444.                parse var bigin tt1 (adelim1) tt2 (adelim2) bigin
  2445.                if TT2="" & bigin="" then
  2446.                    leave
  2447.                IF translate(word(tt2,1))="SELECT" then
  2448.                     leave
  2449.           end
  2450.         end             /* useit */
  2451.      end                        /* select */
  2452.  
  2453.  
  2454.      otherwise
  2455.            putme=""
  2456.      end
  2457.  
  2458. /* strip trailing ctl-z ? */
  2459.    if c2d(right(putme,1))=26 then
  2460.       putme=left(putme,length(putme)-1)
  2461.  
  2462.    bigin=putme||bigin   /* this is the recursive part */
  2463.  
  2464.  
  2465. end                     /*of bigin parse loop */
  2466.  
  2467. if totinc>0  | (goodints+badints)>0 then
  2468.    say " Includes:  " totinc " ; (good/bad interps ) " goodints "," badints
  2469.  
  2470. /* if send mode, then all done */
  2471. if send_piece=1 then do
  2472.    return 'SEND COMPLETE '
  2473. end
  2474.  
  2475. /* Not "send in pieces, so check to
  2476.   do it again for another set of delimiters ? */
  2477.  
  2478. ithdelim=ithdelim+1
  2479.  
  2480.  if symbol('delim_1.ithdelim')="VAR" &  symbol('delim_2.ithdelim')="VAR" then do
  2481.      if delim_1.ithdelm<>"" & delim_2.ithdelm<>"" then do
  2482.           adelim1=delim_1.ithdelim
  2483.           adelim2=delim_2.ithdelim
  2484.           if pos(adelim1,outbig)>0 then do
  2485.              bigin=outbig
  2486.              signal one_more_scan
  2487.           end
  2488.       end
  2489.   end
  2490.  
  2491. /* else, we are done */
  2492.  
  2493. if c2d(right(outbig,1))=26 then
  2494.       outbig=left(outbig,length(outbig)-1)
  2495.  
  2496. if fix_expire>0 then do            /* override goserve response headers */
  2497.    foo=sref_expire_response(fix_expire,length(outbig))
  2498. end
  2499.  
  2500. if auto_header="ALWAYS" then do
  2501.    foo=do_auto_header(OUTbig,1)
  2502. end
  2503.  
  2504. 'var type text/html as ' tfile 'NAME outbig '  /* tell goserve to send it */
  2505.  
  2506. return  1
  2507.  
  2508.  
  2509.  
  2510.  
  2511. /* ----------------------------------------------------------- */
  2512.  Evaluate a cgi-bin (NSCA HTTPD style server side include */
  2513. /* ----------------------------------------------------------- */
  2514. do_cgi_include:
  2515. parse arg thearg
  2516.  
  2517. parse var thearg atype aval
  2518.  
  2519. /* valid atypes:
  2520.   INCLUDE = Include a file
  2521.   ECHO = "replace" with a cgi-bin variable
  2522.   FSIZE= Size of a file
  2523.   FLASTMOD = Last modification date of a file
  2524.   EXEC = Execute a command file or a cgi-program
  2525. */
  2526.  
  2527. tatype=translate(atype)
  2528.  
  2529.   if tatype="INCLUDE" then do
  2530.      parse var aval foo '=' aval
  2531.      aval=strip(strip(aval),,'"')
  2532.  
  2533.      putme=line_include(aval)
  2534.      return putme
  2535.   end
  2536.  
  2537.   if tatype="FSIZE" | tatype="FLASTMOD" then do
  2538.     parse var aval foo '=' aval
  2539.     aval=strip(strip(aval),,'"')
  2540.  
  2541.     afile=line_include(aval,'YES')
  2542.     drop stuff
  2543.     oy=sysfiletree(afile,stuff,'F')
  2544.     if stuff.0=0 then
  2545.          return cgi_inc_errmsg
  2546.  
  2547.     parse var stuff.1 adate atime asize .
  2548.  
  2549.     if tatype="FLASTMOD" then do
  2550.        putme=sref_replacestrg(adate,'-','/','ALL')
  2551.        if cgi_inc_timefmt="ALL" then putme=putme||' '||atime
  2552.        return putme
  2553.     end
  2554.  
  2555.     if tatype="FSIZE" then do
  2556.         if translate(cgi_inc_sizefmt)="ABBREV" then do
  2557.                if asize>=1000000 then
  2558.                        return format(asize/1000000,,2)||'M'
  2559.                if asize>=1000 then 
  2560.                       return format(asize/1000,,2)||'K'
  2561.         end
  2562.         return asize    /* not abbrev, or < 1000 */
  2563.     end
  2564.  
  2565.    end
  2566.  
  2567.   if tatype="CONFIG" then do
  2568.       parse var aval t1 '=' t2  ;t1=translate(t1)
  2569.       t2a=strip(strip(t2),,'"')
  2570.  
  2571.       putme=""
  2572.       select
  2573.         when t1="ERRMSG" then
  2574.                 cgi_inc_errmsg=t2a
  2575.         when t1="TIMEFMT" then          /* non standard for now */
  2576.               cgi_inc_timefmt=translate(t2a)
  2577.         when t1="SIZEFMT" then
  2578.               cgi_inc_sizefmt=translate(t2a)
  2579.         otherwise
  2580.              putme=cgi_inc_errmsg
  2581.       end
  2582.       return putme
  2583.   end
  2584.   if tatype="ECHO" then do
  2585.       parse var aval foo '=' findme ; findme=translate(findme)
  2586.       findme=strip(strip(findme),,'"')
  2587.       select
  2588.          when findme="DOCUMENT_NAME" then
  2589.                 putme=tfile
  2590.          when findme="DOCUMENT_URI" then
  2591.                 putme= seloriginal
  2592.          when findme="DATE_LOCAL" then do
  2593.                putme=date()
  2594.                if cgi_inc_timefmt="ALL" then
  2595.                     putme=putme||' '||time()
  2596.          end
  2597.          when findme="DATE_GMT" then do
  2598.                 putme=date()
  2599.                 if cgi_inc_timefmt="ALL" then
  2600.                         putme=putme||' '||line_replace("TIME_GMT")
  2601.         end
  2602.         when findme="LAST_MODIFIED" then do
  2603.               putme=line_replace("CREATION_DATE")
  2604.               if cgi_inc_timefmt="ALL" then
  2605.                         putme=putme||' '||line_replace("CREATION_TIME")
  2606.         end
  2607.         when findme="SERVER_SOFTWARE" then
  2608.                  putme=server('H')||' '||filter_name
  2609.         when findme="SERVER_NAME" then
  2610.                 putme=servername
  2611.         when findme="GATEWAY_INTERFACE" then
  2612.                 putme="CGI/1.1"
  2613.         when findme="SERVER_PROTOCOL" then
  2614.                 putme=protocol
  2615.         when findme="SERVER_PORT" Then
  2616.                 putme=serverport
  2617.         when findme="REQUEST_METHOD" then
  2618.                 putme=verb
  2619.         when findme="PATH_INFO" then
  2620.                 putme=" Path_info n.a. "
  2621.         when findme="PATH_TRANSLATED" Then
  2622.                 putme="Path_translated n.a. "
  2623.  
  2624.         when findme="SCRIPT_NAME" then
  2625.                 putme=action
  2626.         when findme="QUERY_STRING" then
  2627.                 putme=awords
  2628.         when findme="REMOTE_HOST" then
  2629.               putme=line_replace("USERNAME")
  2630.         when findme="REMOTE_ADDR" then
  2631.                 putme=who
  2632.         when findme="AUTH_TYPE" then
  2633.                 putme="Basic Access Authentication Scheme"
  2634.         when findme="AUTH_NAME" then do
  2635.             afield=reqfield('Authorization')
  2636.             parse var afield . m64 .              /* get the encoded cookie */
  2637.             dec=pack64(m64)                       /* and decode it */
  2638.             parse upper var dec putme ':' .      
  2639.         end
  2640.         when findme="REMOTE_IDENT" then
  2641.                 putme="Remoted_ident n.a. "
  2642.         when findme="CONTENT_TYPE" then
  2643.                 putme="Content_type n.a."
  2644.         when findme="CONTENT_LENGTH" then
  2645.                 putme="Content_length n.a."
  2646.         when abbrev(findme,"HTTP_") then do
  2647.           if findme="HTTP_ACCEPT" then do
  2648.                i = 1
  2649.                 _acc = REQFIELD("accept")
  2650.                acc = '%'
  2651.                ClientAccepts = ''
  2652.                do while (acc \= _acc)
  2653.                  acc = REQFIELD("accept", i)
  2654.                  if (ClientAccepts \= '') then ClientAccepts = ClientAccepts', 'acc
  2655.                  else ClientAccepts = acc
  2656.                  i = i+1
  2657.              end
  2658.  
  2659.               putme=clientaccepts
  2660.           end
  2661.           else do
  2662.                 parse var findme . '_' findme2
  2663.                 putme=reqfield(findme2)
  2664.           end
  2665.         end
  2666.         otherwise
  2667.              putme=cgi_inc_errmsg
  2668.      end                /* select */
  2669.      return putme
  2670.   end
  2671.  
  2672.   if tatype="EXEC" then do
  2673.          parse var aval foo '=' aproc 
  2674.          aproc=strip(strip(aproc),,'"')
  2675.          putme=line_interpret('FILE '||aproc)
  2676.          return putme
  2677.   end
  2678.  
  2679.    return cgi_inc_errmsg
  2680.  
  2681.  
  2682.  
  2683.  
  2684. /* ----------------------------------------------------------- */
  2685. /* Evaluate thearg in SELECT keyphrase                          */
  2686. /* ----------------------------------------------------------- */
  2687. do_select:
  2688. parse arg thearg
  2689.  
  2690.    select.result=1
  2691.    select.results=-135  /* an arbitrary non 0 / 1 value */
  2692.  
  2693.    if translate(thearg)="END" then   /* if thearg="END", it's junk */
  2694.          return 1
  2695.  
  2696.  
  2697.    thearg=translate(thearg, ' ', '090a0d'x)
  2698. /* interpret thearg */
  2699.    signal on syntax  name sele1
  2700.    signal on error name sele1
  2701.    interpret thearg
  2702.    signal off syntax
  2703.    signal off error
  2704.    if select.results <> -135 then   /* aid to sloppy programmers */
  2705.         select.result=select.results
  2706.  
  2707.    signal sele2
  2708.  
  2709. sele1:                  /* here on syntax error */
  2710.     signal off syntax
  2711.     signal off error
  2712.  
  2713.     foo=condition('d')
  2714.     say " Error  in SELECT: " foo
  2715.     audit "Error in SELECT: " thearg " : " foo
  2716.     return 1
  2717.  
  2718. sele2:
  2719.     if select.result=1 then return 1
  2720.  
  2721.     return 0
  2722.  
  2723.  
  2724.  
  2725. /* ----------------------------------------------------------------------- */
  2726. /* Look for INTERPRET keyphrases
  2727. .  note use of interp_data created above
  2728. .  Note: Results of these INTERPRET keyphrases, for inclusion in the document,
  2729. .        must be stored in the INTERPRET.RESULTS variable.
  2730. .
  2731. . There are 3 types of code-blocks:
  2732. .  1) Included in the keyphrase:  INTERPET  CODE rexx code
  2733. .  2) Included in the INTERPET.IN collection of code-blocks: INTERPRET ALABEL
  2734. .  3) In it's own file: INTERPET FILE FILENAME.
  2735. */
  2736. /* ----------------------------------------------------------------------- */
  2737.  
  2738.  
  2739. line_interpret:
  2740. parse arg thisarg
  2741. /* pull block from: { thisarg } block   {nextarg } */
  2742.   thisarg=translate(thisarg, ' ','090a0d'x)  /* Whitespace, etc. */
  2743.   thisarg=strip(thisarg)
  2744.   atype=strip(translate(word(thisarg,1)))
  2745.   select
  2746.     when atype='FILE' then do /*file match */
  2747.       bfile=strip(word(thisarg,2))
  2748.       bfile=do_virtual_file(servdir,bfile)
  2749.  
  2750.       if bfile<>0 then do
  2751.          j0=fileread(bfile,'tmp1')
  2752.          thestring="" 
  2753.          do j1=1 to j0
  2754.            j2=strip(translate(tmp1.j1,' ','000d0a001a'x))
  2755.            j3=right(j2,1)
  2756.            select
  2757.               when j3=";" then
  2758.                   thestring=thestring||j2||crlf
  2759.               when j3="," then
  2760.                    thestring=thestring||left(j2,length(j2)-1)
  2761.               otherwise
  2762.                  thestring=thestring||j2||" ; "||crlf
  2763.             end
  2764.          end
  2765.       end
  2766.       else
  2767.          thestring=0
  2768.    end
  2769.    when atype="CODE" then do
  2770.          thestring= strip(subword(thisarg,2))
  2771.    end
  2772.    otherwise do
  2773.       if interp_data=0 then
  2774.            call get_interpret 
  2775.       thestring=strip(sref_extract_block(interp_data,thisarg))
  2776.    end
  2777.   end
  2778.  
  2779.   if thestring="" | thestring=0 then do
  2780.     say " Can not find INTERPRET keyphrase: " thisarg
  2781.     audit " Can not find INTERPRET keyphrase: " thisarg
  2782.     return ""
  2783.   end
  2784.  
  2785.   thestring=translate(thestring, ' ','090a0d'x)  /* Whitespace, etc. */
  2786.   interpret.results=""          /* clear any residual value */
  2787.   interpret.result=""         /* for sloppy programmers.... */
  2788.  
  2789.   signal on syntax  name doggs ;signal on error name doggs
  2790.   interpret thestring
  2791.   signal off syntax ; signal off error
  2792.   if interpret.results="" then     /* help out forgetfull programmers */
  2793.         interpret.results=interpret.result
  2794.   return interpret.results
  2795.  
  2796. doggs:                  /* here on syntax error */
  2797.   signal off syntax ; signal off error
  2798.   foo=condition('d')
  2799.   say " Error interpreting: " thisarg " : " foo
  2800.   audit "Error interpeting " thisarg " : " foo
  2801.   return ""
  2802.  
  2803.  
  2804.  
  2805. /* ----------------------------------------------------------------------- */
  2806. /*  Look for INCLUDE  keyphrases
  2807. .    If present, pull in lines from INCLUDE file.
  2808. .
  2809. .   Note: INCLUDE files are subject to further processing
  2810. .      -- so BEWARE of recursive TRAPS !
  2811. .  Justfile argument used by CGI_INCLUDE routine
  2812. */
  2813. /* ----------------------------------------------------------------------- */
  2814.  
  2815.  
  2816. line_include:
  2817. parse arg incfil0 , justfile
  2818. justfile=translate(justfile)
  2819.  
  2820. /*---- INCLUDE files can be anywhere (this is not a security hole,
  2821. since requesters can not send "INCLUDE" keyphrases, they can
  2822. only request documents with INCLUDE keyphrases embbedded */
  2823.  
  2824.    incfile=strip(translate(incfil0,'\','/'))    /* just to be thorough */
  2825.    dd0=strip(translate(dir,'\','/'))
  2826.  
  2827. /* if no : or first char is \, then it's  a pathless file name-- assume it's in
  2828. data directory */
  2829.  
  2830.    foo=pos(':',incfile)
  2831.    foo1=left(incfile,1)
  2832.    if foo=0 & foo1<>"\" then
  2833.          incfile=dd0||incfile
  2834.    if justfile="YES" then return(incfile)
  2835.    putme=sref_grab_file(incfile,20)
  2836.    if putme=0 then putme=""
  2837.  
  2838.    return putme
  2839.  
  2840. end   /* INCLUDE= */
  2841.  
  2842.  
  2843.  
  2844. /* ----------------------------------------------------------------------- */
  2845. /* This will do a OPTION replace on the line.
  2846. Keyphrases of the form <!--OPTION=nnn--> are looked for, the nnn is decoded,
  2847. and optlist.nnn is use to replace the keyphrase (if nnn not specified,
  2848. the keyphrase is removed).
  2849. Note that optlist is construced from elements following a ?xxx&xxx type of
  2850. request string (c
  2851. */
  2852. /* ----------------------------------------------------------------------- */
  2853.  
  2854. line_message:
  2855.  
  2856. parse arg id1
  2857. putme=""
  2858. if datatype(id1)='NUM' then
  2859.    if symbol('optlist.id1')='VAR' then  /* check for a mess up */
  2860.           putme=optlist.id1
  2861.  
  2862. return putme
  2863.  
  2864.  
  2865. /* ----------------------------------------------------------------------- */
  2866. /* This will do a REPLACE: on a line.  The currently supported values are
  2867.         DATE        todays date
  2868.        TIMEGMT     current time (GMT)
  2869.        TIME    current time
  2870.        CREATION    A message on the creation date & time of the file
  2871.        CREATION_DATE Just the creation date
  2872.        CREATION_TIME  Just the creation time (use with CREATION_DATE and your own message)
  2873.        WEBMASTER  The contents of the WEBMASTER parameter
  2874.        REFERER   The referer (from the request header)
  2875.       BROWSER   The requesters browser (from the request header)
  2876.         USERNAME   ABC.DDD.GOV type name, or ip address if n.a.
  2877.  
  2878.        INHOUSE.n    n = an integer.  Used for messages to INHOUSE  users only.
  2879.        SUPERUSER.n   n = an integer.  Used for messages to Superusers only
  2880.  
  2881.        HITS         The nth hit for this file (requires looking at Counter_file
  2882.                Also COUNTS, OPTION_HITS.n and OPTION_COUNT.n variants
  2883.        WEBMASTER = Webmaster address
  2884.        SERVERNAME = Name of server (i.e.; WWW.FOO.ORG)
  2885.        SERVER  =    Server software (i.e. GOSERV 2.45)
  2886.        FILTER_NAME = The name of this filter (set at the top of this file)
  2887.  
  2888.        VARIABLE.varname = Extract value of varname.  Examples include
  2889.                         SERVERPORT  PRIVSET
  2890.                         USERNAME    SEL       etc.
  2891.  
  2892.        READ_HEAD    Do a READ HEADER VAR PUTME , append <PRE>
  2893.  
  2894.       and ...  Check replacestrg_file (static replacements) if no match from above.
  2895.  
  2896. /* ----------------------------------------------------------------------- */
  2897.  
  2898. */
  2899.  
  2900. line_replace:
  2901.  
  2902. parse arg targ
  2903. parse upper var targ reparg "." repargn   /* parse out VAR.j types of labels */
  2904.  
  2905. issuper=0 ; isin=0;
  2906. if wordpos('SUPERUSER',translate(privset))>0  then
  2907.     issuper=1
  2908. else
  2909.    if wordpos('INHOUSE',translate(privset))>0 then
  2910.        isin=1
  2911.  
  2912.  
  2913.  
  2914. do while joe>0
  2915.  
  2916.    select
  2917.  
  2918.         when reparg="DATE" then
  2919.               putme=date('N')
  2920.         when reparg="TIME" | reparg="TIMELOCAL" then
  2921.               putme=time('C')
  2922.  
  2923.         when reparg="TIMEGMT" | reparg="TIME_GMT" then do
  2924. /* Computes GMT time as Wed, 12 Aug 1996 21:18:20 format  */
  2925.               fii=sref_new_gmt()
  2926.               parse var fii eek ',' d1 d2 d3 t1
  2927.               putme=t1||'  GMT '
  2928.            end
  2929.  
  2930.        when reparg="DATEGMT" then do
  2931.            fii=sref_new_gmt()
  2932.            parse var fii eek ',' d1 d2 d3 .
  2933.            putme=d1||' '||d2||' '||d3
  2934.        end
  2935.  
  2936.        when reparg="USERNAME" then do
  2937.           if clientname0=0 then
  2938.              putme=clientname()
  2939.           else
  2940.             putme=clientname0
  2941.        end
  2942.        when reparg="FILTER_NAME" | reparg="FILTER_NAME" then
  2943.                 putme=filter_name
  2944.  
  2945.       when reparg="HOME_NAME" | reparg="HOMENAME" then
  2946.                 putme=home_name
  2947.  
  2948.        when reparg="CREATION" then do           /* a creation-date-time message */
  2949.             eek=sysfiletree(translate(file,'\','/'),gosh,'F')
  2950.             poop=gosh.1
  2951.             parse var poop adate atime  .
  2952.             putme =' <em> This document last modified at '||atime||', on '||adate|| '. </em>'
  2953.         end
  2954.  
  2955.  
  2956.        when reparg="CREATION_DATE" then do       /*just the creation date */
  2957.             eek=sysfiletree(translate(file,'\','/'),gosh,'F')
  2958.             poop=gosh.1
  2959.             parse var poop adate atime .
  2960.             putme =adate
  2961.         end
  2962.  
  2963.        when reparg="CREATION_TIME" then do              /* just the creation time */
  2964.             eek=sysfiletree(translate(file,'\','/'),gosh,'F')
  2965.             poop=gosh.1
  2966.             parse var poop adate atime .
  2967.             putme =atime
  2968.         end
  2969.  
  2970.       when reparg="READ_HEAD" then do    /* read/display the request header */
  2971.             'READ HEADER VAR PUTME '
  2972.            putme='<PRE>'||putme||'</pre>'
  2973.      end
  2974.  
  2975.  
  2976.         when (reparg="INHMESS" | reparg="INHOUSE" )&  isin=1 then do
  2977.              putme=inhouse.repargn
  2978.              if symbol('putme')<>'VAR' then putme=" "
  2979.           end
  2980.  
  2981.         when (reparg="SUPMESS" | reparg="SUPERUSER") & issuper=1 then do
  2982.              putme=superuser.repargn
  2983.              if symbol('putme')<>'VAR' then putme=" "
  2984.            end
  2985.  
  2986.         when abbrev(reparg,"REFER")=1 then
  2987.            putme=reqfield("Referer")
  2988.  
  2989.         when (reparg="USER-AGENT" | reparg="BROWSER" ) THen
  2990.             putme=reqfield("User-Agent")
  2991.  
  2992.  
  2993.          when (reparg="URL") then do
  2994.                 putme=sref_fix_url(seloriginal,servername,serverport)
  2995.         end
  2996.  
  2997.         when pos("HIT",reparg)+pos("COUNT",reparg) > 0 then do
  2998.  
  2999.  
  3000.            trymess=pos("OPTION",reparg)
  3001.            dowordy=pos("HIT",reparg)
  3002.            if dowordy>0 then dowordy=1
  3003.            if trymess>0 & symbol('optlist.repargn')='VAR' then do
  3004.                putme=optlist.repargn
  3005.                if dowordy>0 then
  3006.                    putme=OPTION_hit_line||putme    /* use a "message" argument */
  3007.             end
  3008.             else do                      /* get from file (or prior count */
  3009.                putme=get_hit(action,dowordy)
  3010.             end
  3011.          end
  3012.  
  3013.    when reparg="SERVERNAME" | reparg="SERVER_NAME" then  /* servers ip name */
  3014.           putme=servername       /* servername set at top of filter */
  3015.  
  3016.  
  3017.    when reparg="VARIABLE" then do   /* get a variable defined in this filter program */
  3018.  
  3019.       if repargn<>""  then
  3020.           if  symbol('repargn')="VAR"  then
  3021.              putme= value(repargn)
  3022.  
  3023.    end
  3024.    when reparg="SERVER" then
  3025.           putme=server('H')
  3026.  
  3027.    when reparg="WEBMASTER" then
  3028.           putme=webmaster
  3029.  
  3030.    otherwise            /* see if in the replacement strings file*/
  3031.          putme=chk_replaces(targ)  
  3032.  
  3033.     end         /* select */
  3034.  
  3035.  
  3036. return putme            /* return it */
  3037.  
  3038.  
  3039. /* ----------------------------------------------------------------------- */
  3040. /* Scan a replacement strings file for a match with repme.
  3041. .  If found, return the string, else return blank
  3042. . Might first need to read in replacement strings file (or call it down
  3043. . from macrospace)
  3044. */
  3045. /* ----------------------------------------------------------------------- */
  3046.  
  3047.  
  3048. chk_replaces: 
  3049. parse arg  repme
  3050.  
  3051. if replines.0<0 then
  3052.    call setup_replines repme
  3053.  
  3054. if replines.0 =0 then return " " /* no replacement file */
  3055. do  nn=1 to replines.0
  3056.    if repme=replines.nn.label then
  3057.         return replines.nn.value
  3058. end /* do */
  3059.  
  3060. return  ''
  3061.  
  3062.  
  3063.  
  3064.  
  3065.  
  3066. /* ----------------------------------------------------------------------- */
  3067. /* GET_HIT: (used by REPLACE HIT and REPLACE HIT_MESS keyphrases)
  3068. .       look in  counter_file for # of hits (augment count or add entry),
  3069. .           Returns a string with containing # of hits.
  3070. .           If make_wordy_flag, uses the message in the counter_file to
  3071. .           make a "wordy" string.
  3072. .           Note that current_hit stem variable is saved/used (if this
  3073. .           is not the first request for this "anaction", we use results
  3074. .           stored in current_hit.xx)
  3075.  
  3076. .  usage:  astring=get_hit(anaction,make_wordy_flag)
  3077. .
  3078. */
  3079. /* ----------------------------------------------------------------------- */
  3080.  
  3081. get_hit: procedure expose counter_file current_hit.
  3082. parse arg taction , dowordy
  3083.  
  3084. /*  did we already find out which hit this is ? */
  3085.  if translate(current_hit.item)=taction then do  /* Must know current_hit */
  3086.           anum=current_hit.num
  3087.           use1=current_hit.mess1
  3088.           use2=current_hit.mess2
  3089.           if dowordy>0 then
  3090.                putme=use1||" "||anum||" "||use2 ;
  3091.           else
  3092.                putme=anum
  3093.           return putme
  3094.    end
  3095.  
  3096. /* look for it */
  3097. if counter_file=0 then return ""  /* but only if we have a file */
  3098.  
  3099. stuff=sref_lookup_count(counter_file,taction,'ADD',0,0)
  3100. parse var stuff status ict use1 ',' use2
  3101.  
  3102. if status=0 then return ""    /* no file, so no count string */
  3103.  
  3104. /* now put into a string if dowordy>0 */
  3105.     if dowordy=0 then
  3106.          putme=ict
  3107.     else do
  3108.        if use1=" " & use2=" " then
  3109.           use1=" # of hits = "
  3110.        else do
  3111.           use1=STRIP(use1) ; use2= STRIP(use2)
  3112.        end
  3113.  
  3114.        putme=use1||" "||ict||" "||use2
  3115.      end
  3116.  
  3117.      current_hit.num=ict      /* save current hit */
  3118.      current_hit.item=taction
  3119.      current_hit.mess1=use1
  3120.      current_hit.mess2=use2
  3121.  
  3122.      return putme
  3123.  
  3124.  
  3125.  
  3126.  
  3127.  
  3128. /* ---------------------------End  of ssi routines----------------------------*/
  3129. /**************************************************************************/
  3130.  
  3131. /*************************************************************************/
  3132. /* ----------------------Miscellanoue routines---------------------------*/
  3133.  
  3134. /* -----------------------------------------------------------------------*/
  3135. /*  Write a 'busy server' response file */
  3136. /* -----------------------------------------------------------------------*/
  3137.  
  3138. busy_server: procedure
  3139. parse arg tempfile, action
  3140.  
  3141.  asn=servername()
  3142.  amessx='Server action need to process "'sel'", but the server is busy. '
  3143.   return 0
  3144.  
  3145.  
  3146. /* ----------------------------------------------------------------------- */
  3147. /* ALIAS_ACTION: look in alias_file for "action" aliases
  3148. .   usage: newaciton=alias_action(anaction)
  3149. .  Wildcard matching is supported.
  3150. .  The basic idea is:
  3151. .  given a candiate STRING
  3152. .  look for a matching TARGET, and if one is found
  3153. .  use the REPLACE_STRING as a (partial) substitute for the STRING.
  3154.  
  3155. .  The alias_file is structured as:
  3156. .  Target*xx replace_string*xx    (the *'s and xx are optional)
  3157. .   
  3158. .  The wildcard matching procedure is used extensively
  3159. .
  3160. . Note that replace_string can take some special values:
  3161. .   !TRANSFER - Transfer a file from any directory (not just a data directory)
  3162. .   !MOVED http://xxxxx   - Return a "moved" response to the http://xxx url.
  3163. .
  3164. */
  3165. /* ----------------------------------------------------------------------- */
  3166.  
  3167. alias_action: procedure EXPOSE ALIAS_file macrospace_input
  3168. parse  arg sel0 
  3169.  
  3170. call file_or_macro "ALIASES"
  3171.  
  3172. tsel=translate(sel0)
  3173. gotit=0 ; doexact=0
  3174. do m=1 to 100000                        /* look in public_files list */
  3175.     if  symbol('filelines.m')<>"VAR"  then leave
  3176.     ares=sref_wildcard(tsel,filelines.m,doexact)
  3177.     parse var ares astat "," aurl ;  astat=strip(astat)
  3178.  
  3179.     if astat=0 then iterate   /* no match */
  3180.     aurl=strip(aurl)
  3181.     gotit=m
  3182.     if aurl="" then do
  3183.           usesel=tsel
  3184.     end
  3185.     else do
  3186.           usesel=aurl
  3187.     end
  3188.     if ares=1 then
  3189.        leave           /*first exact match rules */
  3190.     else
  3191.        doexact=1
  3192. end
  3193.  
  3194. if gotit>0 then        /* if gotit, then reset the sel */
  3195.    return gotit ' ' usesel
  3196. else
  3197.    return 0 " " sel0
  3198.  
  3199.  
  3200.  
  3201. /* --------------------------MESSAGE BOX UTILITIES ---------------------------------*/
  3202. /* The following is a set of message box utilities.  If the exposes were
  3203. checked, it could be placed in a seperate file
  3204. */
  3205. /* ----------------------------------------------------------------------- */
  3206.  
  3207. /* ----------------------------------------------------------------------- */
  3208. /* create a form to select a message box */
  3209. /* ----------------------------------------------------------------------- */
  3210.  
  3211. what_messbox: procedure expose tempfile messbox_dir
  3212. parse arg header
  3213. if header=" " then header="Message Boxes"
  3214.  
  3215.  
  3216.  
  3217.  call lineout tempfile, '<!doctype html public "-//IETF//DTD HTML 2.0//EN">'
  3218.   call lineout tempfile, "<html><head><title>Message Box Selection</title></head>"
  3219.  ee=messbox_dir||"\*.LOG"
  3220.  eej=sysfiletree(ee,gotlog,'F')
  3221.  
  3222. /* no messages box files? */
  3223. if gotlog.0=0 then do
  3224.      call lineout tempfile,' <STRONG> No messages boxes exist ! </strong> '
  3225. call lineout tempfile,'<hr> <a href="/" rel="Parent"> Return to home page </a> '
  3226.       call lineout tempfile,'</body> </html> '
  3227.       call lineout tempfile
  3228.     return 0
  3229. end
  3230.  
  3231.  
  3232. header=translate(header, ' ', '+'||'090a0d'x)  /* Whitespace, etc. */
  3233. header=packur(header)
  3234.  
  3235.  
  3236. /* else, create a form with message boxes listed therein */
  3237. call lineout tempfile, '<!doctype html public "-//IETF//DTD HTML 2.0//EN">'
  3238.  
  3239. call lineout tempfile, "<body><h2>" header "</h2>"
  3240. call lineout tempfile,' Please view .. ?'
  3241. call lineout tempfile,' <FORM ACTION="!viewmess" METHOD="GET"> '
  3242. call lineout tempfile,' <SELECT NAME="messbox" SIZE=5> '
  3243.  
  3244.  
  3245. do mm=1 to gotlog.0
  3246.    aff=filespec('name',gotlog.mm)
  3247.    parse  var aff affname "." .
  3248.    affname=translate(affname)
  3249.    al2='<OPTION value="'||affname||'" >Messages to '||affname
  3250.    call lineout tempfile,al2
  3251. end
  3252. call lineout tempfile,'</SELECT>'
  3253. call lineout tempfile,'<INPUT TYPE="submit" VALUE="Get Messages">'
  3254.  
  3255. call lineout tempfile,'</FORM> <hr>'
  3256. call lineout tempfile,'<a href="/" rel="Parent"> Return to home page </a>'
  3257.  
  3258. call lineout tempfile,'</body> </html>'
  3259. call lineout tempfile
  3260.  
  3261. return 1
  3262.  
  3263. /* ----------------------------------------------------------------------- */
  3264. /* Set up a return string to look at the messages in desired message box */
  3265. /* ----------------------------------------------------------------------- */
  3266.  
  3267. viewmessage: procedure expose  messbox_dir tempfile
  3268.  
  3269. parse arg list
  3270.  
  3271. parse var list atype '=' abox
  3272.  
  3273. t1=messbox_dir||"/"||abox||".LOG"
  3274.  
  3275. ause=stream(t1,'c','query exists')
  3276. if ause="" then do
  3277.   call lineout tempfile, '<!doctype html public "-//IETF//DTD HTML 2.0//EN">'
  3278.  
  3279.   call lineout tempfile, "<html><head><title>Messages Can Not Be Viewed</title></head>"
  3280.   call lineout tempfile, "<body>"
  3281.   call lineout tempfile, "<h2>Could not view message box </h2>"
  3282.   call lineout tempfile, " Could not find the " abox " message box. <hr>"
  3283.   call lineout tempfile,'<a href="/" rel="Parent"> Return to home page </a>'
  3284.   call lineout tempfile, "<hr></body></html>"
  3285.   call lineout tempfile
  3286.  
  3287.   eek='FILE ERASE TYPE text/html NAME '||tempfile
  3288.  end
  3289.  
  3290. else
  3291.    eek= 'FILE TYPE text/plain nocache NAME ' t1
  3292.  
  3293. return eek
  3294.  
  3295. /* --------------------------End of message box utilities------------------- */
  3296.  
  3297.  
  3298. /******************************************************************************/
  3299. /* ------------------------------------------------------------------------ */
  3300. /* DO_VIRTUAL_FILE: Convert from URL to file name-- add virtual directory of data directory.
  3301.     ddir : data directory
  3302.     sel : request string (after sre-filter has modified it)
  3303.     virtual_dir : List of virtual file replacement possiblities.
  3304.           virtual_dir.label.nv      virtual_dir.dir.nv      virtual_dir.subok
  3305.     Return: file name (with drive/directory) or 0 if not found/not allowed
  3306. */
  3307.  
  3308. DO_VIRTUAL_FILE:PROCEDURE Expose virtual_file macrospace_input
  3309. parse arg ddir,action,nocheck
  3310.  
  3311. signal on error name novirt1 ; signal on syntax name novirt1  /* in case macro proc n.a.*/
  3312.  
  3313. virtok=0
  3314. ado=SREF_DO_VIRTUAL(ddir,action , macrospace_input ,virtual_file)
  3315. virtok=1
  3316. novirt1:
  3317. signal off syntax ; signal off error
  3318.  
  3319. if virtok=0 then say " problem with virtual file lookup "
  3320.  
  3321. if abbrev(translate(ado),'HTTP:\\')=1 then do
  3322.    ado=translate(ado,'/','\')
  3323.    say " Move: " ado
  3324.    parse var ado aurl .   /* parse out junk */
  3325.    is301=301
  3326.    FOO=moved(aurl,is301)
  3327.    FOO
  3328.    return "!MOVED"
  3329. end
  3330.  
  3331. if virtok=0 | ado=0 then do
  3332.   ddir=translate(ddir,'\','/')
  3333.   ddir=strip(ddir,'t','\')
  3334.   ado=translate(ddir||'\'||action,'\','/')
  3335. end
  3336.  
  3337. if nocheck<>1 then do
  3338.    ado=stream(ado,'c','query exists')
  3339.    if ado="" then ado=0
  3340. end
  3341.  
  3342. return ado
  3343.  
  3344.  
  3345.  
  3346. /***************************************************************************/
  3347. /* ---------- Start of access control (logon) procedures section ----------*/
  3348.  
  3349. /*
  3350. do_logon : Main logon routine for requests. Will send out an authorization
  3351.            response if necessay
  3352.            Calls loguser
  3353.  
  3354.  
  3355. Ispriv(target) : Determines if requester has the target privilege.  If not,
  3356.                 check user_file, or do an authorization.  Call loguser
  3357.  
  3358.  
  3359. loguser:   Checks if a inhouseips.  If not, sees for verification field. If there,
  3360.            compares agains user_file.  If not, tells do_logon or ispriv to ask for
  3361.            authorization
  3362. Goodips and badips: checks agains inhouseips and disallowedips stem variables.
  3363. Also pulls inhouseips. specific privset out.
  3364.  
  3365. */
  3366.  
  3367.  
  3368. /* -----------------------------------------------------------------------*/
  3369. /* LOGON checking
  3370. .  This basically calls loguser, and then either let's the requester
  3371. .  back into the main filter, or asks for another username/password attempt.
  3372. .  Thus, we only return from this with a sucess --  or we go back to
  3373. .      GOSERVE with a "send authorization" response.
  3374. */
  3375. /* -----------------------------------------------------------------------*/
  3376.  
  3377. do_logon: procedure expose inhouseips. inhouse user_file inhouse_privs  source0 request0 seloriginal clientname0 macrospace_input
  3378.  
  3379.   parse arg anip , howtough
  3380.  
  3381.  /* Check if legit user.  */
  3382.    logtest = loguser(anip)
  3383.    parse var logtest isallowed username  privset
  3384. /*  not allowed? -- ask user for logn info (maybe for the nth time! */
  3385.   if isallowed= 0 then do
  3386.      'header add WWW-Authenticate: Basic Realm=<'|| inhouse|| '>'  /* challenge */
  3387.      exit response('unauth', "for realm " inhouse " was not authorized")
  3388.   end
  3389. /* NOTE: after exiting to goserv, goserv will recall this filter when answer sent
  3390.    back by requester. */
  3391.  
  3392. /* if here, allowed -- accept we might check for INHOUSE only in caller! */
  3393.     return username  privset
  3394.  
  3395.  
  3396. /* -----------------------------------------------------------------------*/
  3397. /* Check privileges.  Note that priviliges are met with privset
  3398. .   This may require a logon.
  3399. .   This procedure is often used for "secondary" logons
  3400. .   (i.e.; to ascertain mail, server reset, and similar privileges) */
  3401. /* -----------------------------------------------------------------------*/
  3402.  
  3403. ispriv: procedure expose tempfile inhouse inhouseips. user_file privset inhouse_privs clientname0 macrospace_input
  3404. parse arg targclass
  3405.  
  3406.   if wordpos("SUPERUSER",privset)>0 then return 1    /* superuser has all privs */
  3407.   if wordpos(targclass,privset)>0 then return 1  /* may already have been set*/
  3408.  
  3409. /* if not already got this privilege
  3410.       Force user to logon (auto logon not sufficient, need to check privs) */
  3411.    logtest = loguser("0.0.0.0")
  3412.    parse var logtest isallowed  username privset
  3413.  
  3414. /*  if noauth found, try  a www-authorize request. We will end up back in
  3415.      this routine after client responds (and will have a privset) to check*/
  3416.    if username="NOAUTH" then do
  3417.          say " Need privs, so user has to logon "
  3418.          'header add WWW-Authenticate: Basic Realm=<'|| inhouse|| '>'  /* challenge */
  3419.          exit response('unauth', "for realm " inhouse " was not authorized")
  3420.    end
  3421.  
  3422.    if targclass=" " then return privset  /* ' ' means return it, no checking*/
  3423.  
  3424. /* if here, got some kind of logon stuff, which did not match privset */
  3425.  
  3426.  
  3427. /* See if got the right privilige  */
  3428.     FOO2=WORDPOS(TARGCLASS,PRIVSET)
  3429.     if foo2 > 0 then return 1   /* he has this privilege */
  3430.  
  3431. /* might be a non-owner superuser? */
  3432.     if wordpos("SUPERUSER",privset)>0 then return 1
  3433.  
  3434.  
  3435. /* if here, does not have this privilige */
  3436.        foo=not_allowed_message(username,isallowed)
  3437.  
  3438.       return 0
  3439.  
  3440.  
  3441. /* -----------------------------------------------------------------------*/
  3442. /* Function to check on whether this guy is legitimate or not.
  3443. . If  not from inhouse domains (set in inhouseips.)   then hit him up for
  3444. . username/password authorization (and then perhaps tell GOSERVE to ask for it)
  3445. .
  3446. .  Returns  isallowed  username privs :
  3447. .        isallowed: 1 if okay, 0 if failed
  3448. .        username : if inhouse, then xxx from xxx.yyy.etc, else IP address
  3449. .        privs : special privileges (might be several)
  3450.  
  3451. NOTE: Superuser should NOT go through this (SUPERUSERS are not detected here
  3452. */
  3453. /* -----------------------------------------------------------------------*/
  3454.  
  3455. loguser:procedure expose inhouseips. inhouse user_file crlf inhouse_privs ,
  3456.                   clientname0 macrospace_input
  3457. parse arg whome         /* the fellows ip address */
  3458.  
  3459. crlf='0d0a'x
  3460.  
  3461. if whome='0.0.0.0' then signal trylog   /* explicitly do not check inhouse*/
  3462.  
  3463.    call goodips(whome)  /* is this an inhouse connect */
  3464.    isinhouse=result
  3465.    if isinhouse=0 then signal trylog
  3466.  
  3467. /* if here, inhouse'ers are let off easy.. */
  3468.     if clientname0=0 then
  3469.         myname=clientname()
  3470.     else
  3471.        myname=clientname0
  3472.     parse var myname myname1 "."
  3473.  
  3474.     return 1 myname1 inhouse_Privs||' '||privset1
  3475.  
  3476.  
  3477. /* jump here to allow user to attempt a logon */
  3478. trylog:
  3479.   afield=reqfield('Authorization')    /* see if incoming authorization available */
  3480.  
  3481. /* if no authorization found, then let calling routine know
  3482.    (so a www-auth can be done */
  3483.   if afield=" " then
  3484.        return  0  NOAUTH  0           /* no auth, maybe ask?*/
  3485.  
  3486. /* otherwise, we got an authorization (probably due to a prior request
  3487.    that came here).  So... check his username/password */
  3488.   parse var afield . m64 .              /* get the encoded cookie */
  3489.   dec=pack64(m64)                       /* and decode it */
  3490.   parse upper var dec user ':' pwd      /* split to userid and password */
  3491.  
  3492. /*  Now see if user and pw are on the user_file list:
  3493. .         user pwd  class  privset            (first user)
  3494. .   Note that privset can be many words
  3495. .   (in a sense, class is just the first of the privset !
  3496. */
  3497.  
  3498.  
  3499. call file_or_macro "USER"
  3500. nlines=filelines.0
  3501.  
  3502. if nlines=0 then do
  3503. say " no User file "
  3504.     return 0 NOFILE 0
  3505. end
  3506.  
  3507. /* scan users file */
  3508. do mm=1 to nlines
  3509.    parse upper var filelines.mm auser apwd  privset
  3510.    if (auser = user | auser='*') & (apwd = pwd | apwd='*') then  do
  3511.       return 1  auser  privset
  3512.   end
  3513. end
  3514.  
  3515. /* if here, no such user */
  3516. return 0  NOTUSER  0
  3517.  
  3518.  
  3519.  
  3520.  
  3521.  
  3522. /* -----------------------------------------------------------------------*/
  3523. /* see if matches one of a set of bad ips (1 if yes)*/
  3524. /* -----------------------------------------------------------------------*/
  3525. badips:
  3526.  
  3527. parse arg anips
  3528. parse var anips ip.1 '.' ip.2 '.' ip.3 '.' ip.4
  3529. mm=0
  3530. do forever
  3531.   mm=mm+1
  3532.   if symbol('unallowedips.mm')<>"VAR" then return 0
  3533.   parse var unallowedips.mm uip.1 '.' uip.2 '.' uip.3 '.' uip.4
  3534.   match=1
  3535.   do mm2=1 to 4
  3536.       if uip.mm2="*" then iterate
  3537.       if uip.mm2=ip.mm2 then iterate
  3538.       match=0       /*if here, not a match */
  3539.       leave
  3540.   end
  3541.   if match=1 then  return 1   /* got a match */
  3542. end
  3543.  
  3544.  
  3545.  
  3546. /* -----------------------------------------------------------------------*/
  3547. /* see if matches one of a set of good ips (1 if yes)*/
  3548. /* -----------------------------------------------------------------------*/
  3549. goodips: procedure expose inhouseips. privset1
  3550.  
  3551. parse arg anips
  3552. parse var anips ip.1 '.' ip.2 '.' ip.3 '.' ip.4
  3553. mm=0 ; ndo=0
  3554.  
  3555. do mm=1 to 10000              /*how many inhouseips. are there */
  3556.   if symbol('inhouseips.mm')<>"VAR" then leave
  3557.   if inhouseips.mm=" " then leave
  3558.   if inhouseips.mm=0 then leave
  3559.   ndo=ndo+1
  3560. end
  3561. if ndo=0 then return 0
  3562. do m2=1 to ndo   /* exact matches first */
  3563.   parse var inhouseips.m2 uip.1 '.' uip.2 '.' uip.3 '.' uip.4 privset1
  3564.   match=0
  3565.   do mm2=1 to 4
  3566.     if ip.mm2=uip.mm2 then 
  3567.        match=match+1
  3568.   end
  3569.   if match=4 then
  3570.         return 1                /*got an exact match */
  3571. end
  3572. match=1                 
  3573. do m2=1 to ndo           /* wild card matches */
  3574.      match=1
  3575.      parse var inhouseips.m2 uip.1 '.' uip.2 '.' uip.3 '.' uip.4 privset1
  3576.      do mm2 =1 to 4
  3577.        if uip.mm2="*" then iterate
  3578.        if uip.mm2=ip.mm2 then iterate
  3579.        match=0       /*if here, not a match */
  3580.        leave
  3581.      end
  3582.      if match=1 then return 1
  3583. end
  3584. return 0                /* no match */
  3585.  
  3586.  
  3587.  
  3588. /* --------------------------------------- */
  3589. /* Generate a "you can't have this "message */
  3590. /* if here, does not have this privilige */
  3591. not_allowed_message: procedure expose tempfile
  3592.  parse arg username, isauser
  3593.  
  3594.   call lineout tempfile, '<!doctype html public "-//IETF//DTD HTML 2.0//EN">'
  3595.   call lineout tempfile, "<html><head><title>Not privileged user</title>"
  3596.   call lineout tempfile, "</head>"
  3597.   call lineout tempfile, "<body><h2>Not a privileged user!</h2>"
  3598.  
  3599.   if isauser=0 then
  3600.            call lineout tempfile, "<p> You do NOT have logon rights  "
  3601.   else
  3602.           call lineout tempfile, "<p>" username " is not given access to this URL "
  3603.  
  3604.   call lineout tempfile, "</body></html>"
  3605.   call lineout tempfile  /* close */
  3606.  return 0
  3607.  
  3608.  
  3609. /*------------*/
  3610. /* Access control routine */
  3611.  
  3612. sref_allow_access:procedure expose macrospace_input ssi_allow ssp_allow
  3613.  
  3614. parse upper arg sel, allow_access, access_file , privset
  3615.  
  3616. /* superusers are home free */
  3617. /* if wordpos("SUPERUSER",translate(privset)) > 0 then
  3618.               return 10000*/
  3619.  
  3620. /* no access controls */
  3621.  if allow_access="YES" & ssi_allow=1 & ssp_allow=1 then   /* everyone gets */
  3622.         return 10000
  3623.  
  3624. /* inhouse is given access if ssi and ssp are allowed.*/
  3625.  if allow_access="INHOUSE" then   /* inhouse and superusers aren't hassled*/
  3626.        if wordpos("INHOUSE",translate(privset)) > 0 then
  3627.            if ssi_allow=1 & ssp_allow=1 then
  3628.               return 10000
  3629.  
  3630. /* if here, check file specific privileges (any access, ssi and ssp privs) */
  3631.  
  3632.  call file_or_macro 'ACCESS'
  3633.  
  3634. /* first successful wildcard match rules! */
  3635.  sel=translate(sel,'/','\')
  3636.  do im=1 to filelines.0
  3637.      amatch=0
  3638.      parse upper var filelines.im alabel0 aprivs "," ssissp
  3639.      alabel0=translate(alabel0,'/','\') 
  3640.  
  3641.      ares=sref_wildcard(sel,alabel0)
  3642.      parse var ares amatch ',' alabel
  3643.  
  3644.      if amatch>0 then do                /* match -- check privs */
  3645.         select
  3646.           when wordpos('NO',aprivs)>0 then do
  3647.               nop
  3648.           end
  3649.           when aprivs="" | wordpos('*',aprivs)>0 | wordpos('YES',aprivs)>0 then do
  3650.                 say " All access permited #: " im ssissp
  3651.                 return ssissp   /* open to all */
  3652.           end
  3653.           otherwise do
  3654.  
  3655.              do mm=1 to words(aprivs)
  3656.                 if wordpos(word(aprivs,mm),privset)>0 then do
  3657.                    say " Access permited #: " im ssissp
  3658.                     return ssissp
  3659.                 end
  3660.              end   / *mm */
  3661.  
  3662.           end  / * otherwise */
  3663.  
  3664.         end  /* selec t? */
  3665.      end   /* check */
  3666.    end    /*  filelines */
  3667.  
  3668. /* inhouse is given access (and by default, ssi and sspl */
  3669.    if allow_access="INHOUSE" then do  /* inhouse and superusers aren't hassled*/
  3670.        if wordpos("INHOUSE",translate(privset)) > 0 then
  3671.             return 10000 
  3672.     end
  3673.  
  3674. /* if here, not superuser or inhouse, and no match -- hence, no access */
  3675.    say " Match failed against: " filelines.im
  3676.     return 0
  3677.  
  3678.  
  3679. /* -----------------------------------------------------------------------*/
  3680. /* check for a "range request". If none found, then return 0.
  3681.    Else, return an appropriate VAR response, or if multiple
  3682.    sends, a 1
  3683. For details on range retrieval, see draft-ieft-http-range-retrieval-00.txt
  3684. (try ds.internic.net)
  3685.  */
  3686. /* -----------------------------------------------------------------------*/
  3687.  
  3688. process_range: procedure expose outbig
  3689.   parse arg afile,atype
  3690.  
  3691.   ranges=reqfield('range:')
  3692.  
  3693.   if ranges="" then do
  3694.     'HEADER ADD Accept-Ranges: bytes '
  3695.      return 0
  3696.   end
  3697.  
  3698. /* else, found a byte acceptance range */
  3699.   parse upper var ranges foo1 'BYTES=' vlist
  3700.  
  3701.   if vlist="" then do
  3702.     'HEADER ADD Accept-Ranges: bytes '
  3703.      return 0             /* no range list found */
  3704.   end
  3705.  
  3706.   filen=chars(afile)
  3707.   aa=stream(afile,'c','close')
  3708.  
  3709. /* if bad request, signal 0 to return entire file */
  3710.   ndo=0
  3711.   do until vlist=""
  3712.  
  3713.      parse var vlist aterm ',' vlist
  3714.      parse var aterm  t1 '-' t2
  3715.      if t1<>"" then
  3716.              if datatype(t1)<>'NUM' then iterate
  3717.      if t2<>"" then
  3718.              if datatype(t2)<>'NUM' then return iterate
  3719.  
  3720.      if t1="" & t2="" then iterate
  3721.      if t2="" then t2=filen
  3722.      if t1="" then do
  3723.         t1=filen-t2
  3724.         t2=filen
  3725.      end
  3726.      if t1<0 then t1=0
  3727.      if t2>(filen-1) then t2=filen-1
  3728.      if t2<t1 then iterate             /* bad request */
  3729.  
  3730.      ndo=ndo+1
  3731.      r1.ndo=t1  ; r2.ndo=t2
  3732.    end
  3733.  
  3734.  
  3735.    if ndo=0 then do
  3736.       'HEADER ADD Accept-Ranges: bytes '
  3737.        say " no acceptable ranges "
  3738.        return 0              /* no acceptable ranges */
  3739.    end
  3740.  
  3741.  
  3742.    atd=dosfileinfo(afile,'W')
  3743.    dd1=word(atd,1) ; tt1=word(atd,2)
  3744.    atd1=dateconv(dd1,'U','B')
  3745.    parse var tt1 hr ':' min ':' sec
  3746.    atd2=hr*3600 + min*60 + sec
  3747.    atd3=sref_new_gmt(0,atd1,atd2)
  3748.  
  3749.    if ndo>1 then say " Byte serving # ranges= " ndo
  3750.    if ndo=1 then do
  3751.        aa=sref_expire_response(-1,filen,atype,'Y')
  3752.       'SET NETBUFFER OFF'
  3753.        'RESPONSE HTTP/1.0 206 Partial Content'     /* Set HTTP response line */
  3754.  
  3755.        t1=r1.1 ; t2=r2.1
  3756.        nget=(1+t2)-t1
  3757.        outbig=charin(afile,1+t1,nget)
  3758.        boog='VAR TYPE '|| atype|| ' as '|| afile ' NAME OUTBIG '
  3759.  
  3760.        foo1=t1||'-'||t2'/'filen
  3761.       'HEADER ADD Content-length:' foo1
  3762.       'HEADER ADD Last-Modified: ' atd3 ' GMT '
  3763.       'HEADER ADD Accept-Ranges: bytes '
  3764.  
  3765.        return boog
  3766.     end
  3767.  
  3768. /* else, multi part send */
  3769. /* check to see that it's supported */
  3770.     conn1=translate(strip(reqfield('connection:')))
  3771.     if conn1="MAINTAIN" | conn1="KEEP-ALIVE" then
  3772.         nop
  3773.     else do
  3774.        'HEADER ADD Accept-Ranges: bytes '
  3775.        say " connection:keep-alive not specified "
  3776.        return 0
  3777.     end
  3778.    crlf='0d0a'x                /* useful */
  3779.    bound=copies("x",41)        /* boundary data for part [could be random] */
  3780.    mimestart='--'bound''crlf   /* starts a MIME multipart section */
  3781.    mimeend  ='--'bound'--'crlf /* ends a MIME multipart section */
  3782.  
  3783.   /* Send the header and first boundary */
  3784.  'RESPONSE HTTP/1.0 206 Partial Content'     /* Set HTTP response line */
  3785.  
  3786.  'set netbuffer off'         /* turn off buffering */
  3787.   'send type multipart/x-byteranges;boundary='bound
  3788.   'string' mimestart          /* Or could be: 'var name mimestart' */
  3789.  
  3790.  
  3791.  
  3792.   do mm=1 to ndo
  3793.     outbig=''
  3794.     outbig=outbig||'Content-type: '||atype||crlf
  3795.  
  3796.       t1=r1.mm ; t2=r2.mm
  3797.       nget=(1+t2)-t1
  3798.       out1=charin(afile,1+t1,nget)
  3799.       foo1=t1||'-'||t2'/'filen
  3800.     outbig=outbig||'Content-range: bytes '|| foo1||crlf
  3801.     outbig=outbig||crlf
  3802.     outbig=outbig||out1||crlf
  3803.     if mm< ndo then
  3804.        outbig=outbig||mimestart
  3805.     else
  3806.        outbig=outbig||mimeend
  3807.     'var name outbig '
  3808.   end
  3809.   'SEND COMPLETE '
  3810.   return 'CLOSE'
  3811.  
  3812.  
  3813.  
  3814. /******************/
  3815. /* send file in 500byte chunks (get around netscape drop sockets? problem)*/
  3816.  
  3817. send_bits:procedure
  3818. parse arg afile
  3819.  
  3820. 'SET NETBUFFER OFF'
  3821. 'SEND TYPE text/html as ' afile
  3822. mm=chars(afile)
  3823. nn=1
  3824. do until nn>mm 
  3825.  oy=charin(afile,nn,1000)
  3826.  say nn mm length(oy)
  3827.  oy=translate(oy,' ','000a0d1a'x)
  3828.  
  3829.   'VAR NAME OY '
  3830.   nn=nn+1000
  3831.  end
  3832. return ' '  
  3833. say " pre send complete "
  3834. 'SEND COMPLETE'
  3835. say " post send compte "
  3836. return ' '
  3837.  
  3838.